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, 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 (require 'calendar)
  41
  42 (defun hebrew-calendar-leap-year-p (year)
  43   "Non-nil if YEAR is a Hebrew calendar leap year."
  44   (< (% (1+ (* 7 year)) 19) 7))
  45
  46 (defun hebrew-calendar-last-month-of-year (year)
  47   "The last month of the Hebrew calendar YEAR."
  48   (if (hebrew-calendar-leap-year-p year)
  49       13
  50     12))
  51
  52 (defun hebrew-calendar-elapsed-days (year)
  53   "Days from Sunday before start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
  54   (let* ((months-elapsed
  55           (+ (* 235 (/ (1- year) 19)) ; months in complete cycles so far
  56              (* 12 (% (1- year) 19))  ; regular months in this cycle
  57              (/ (1+ (* 7 (% (1- year) 19))) 19))) ; leap months this cycle
  58          (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
  59          (hours-elapsed (+ 5
  60                            (* 12 months-elapsed)
  61                            (* 793 (/ months-elapsed 1080))
  62                            (/ parts-elapsed 1080)))
  63          (parts                         ; conjunction parts
  64           (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
  65          (day                           ; conjunction day
  66           (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
  67          (alternative-day
  68           (if (or (>= parts 19440) ; if the new moon is at or after midday
  69                   (and (= (% day 7) 2)  ; ...or is on a Tuesday...
  70                        (>= parts 9924) ; at 9 hours, 204 parts or later...
  71                        ;; of a common year...
  72                        (not (hebrew-calendar-leap-year-p year)))
  73                   (and (= (% day 7) 1)  ; ...or is on a Monday...
  74                        (>= parts 16789) ; at 15 hours, 589 parts or later...
  75                        ;; at the end of a leap year.
  76                        (hebrew-calendar-leap-year-p (1- year))))
  77               ;; Then postpone Rosh HaShanah one day.
  78               (1+ day)
  79             ;; Else:
  80             day)))
  81     ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
  82     (if (memq (% alternative-day 7) (list 0 3 5))
  83         ;; Then postpone it one (more) day and return.
  84         (1+ alternative-day)
  85       ;; Else return.
  86       alternative-day)))
  87
  88 (defun hebrew-calendar-days-in-year (year)
  89   "Number of days in Hebrew YEAR."
  90   (- (hebrew-calendar-elapsed-days (1+ year))
  91      (hebrew-calendar-elapsed-days year)))
  92
  93 (defun hebrew-calendar-long-heshvan-p (year)
  94   "Non-nil if Heshvan is long in Hebrew YEAR."
  95   (= (% (hebrew-calendar-days-in-year year) 10) 5))
  96
  97 (defun hebrew-calendar-short-kislev-p (year)
  98   "Non-nil if Kislev is short in Hebrew YEAR."
  99   (= (% (hebrew-calendar-days-in-year year) 10) 3))
 100
 101 (defun hebrew-calendar-last-day-of-month (month year)
 102   "The last day of MONTH in YEAR."
 103   (if (or (memq month (list 2 4 6 10 13))
 104           (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
 105           (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
 106           (and (= month 9) (hebrew-calendar-short-kislev-p year)))
 107       29
 108     30))
 109
 110 (defun calendar-absolute-from-hebrew (date)
 111   "Absolute date of Hebrew DATE.
 112 The absolute date is the number of days elapsed since the (imaginary)
 113 Gregorian date Sunday, December 31, 1 BC."
 114   (let ((month (extract-calendar-month date))
 115         (day (extract-calendar-day date))
 116         (year (extract-calendar-year date)))
 117     (+ day                              ; days so far this month
 118        (if (< month 7)                  ; before Tishri
 119            ;; Then add days in prior months this year before and after Nisan.
 120            (+ (calendar-sum
 121                m 7 (<= m (hebrew-calendar-last-month-of-year year))
 122                (hebrew-calendar-last-day-of-month m year))
 123               (calendar-sum
 124                m 1 (< m month)
 125                (hebrew-calendar-last-day-of-month m year)))
 126          ;; Else add days in prior months this year.
 127          (calendar-sum
 128           m 7 (< m month)
 129           (hebrew-calendar-last-day-of-month m year)))
 130        (hebrew-calendar-elapsed-days year) ; days in prior years
 131        -1373429)))               ; days elapsed before absolute date 1
 132
 133 (defun calendar-hebrew-from-absolute (date)
 134   "Compute the Hebrew date (month day year) corresponding to absolute DATE.
 135 The absolute date is the number of days elapsed since the (imaginary)
 136 Gregorian date Sunday, December 31, 1 BC."
 137   (let* ((greg-date (calendar-gregorian-from-absolute date))
 138          (year (+ 3760 (extract-calendar-year greg-date)))
 139          (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
 140                       (1- (extract-calendar-month greg-date))))
 141          day)
 142     (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
 143       (setq year (1+ year)))
 144     (let ((length (hebrew-calendar-last-month-of-year year)))
 145       (while (> date
 146                 (calendar-absolute-from-hebrew
 147                  (list month
 148                        (hebrew-calendar-last-day-of-month month year)
 149                        year)))
 150         (setq month (1+ (% month length)))))
 151     (setq day (1+
 152                (- date (calendar-absolute-from-hebrew (list month 1 year)))))
 153     (list month day year)))
 154
 155 (defconst calendar-hebrew-month-name-array-common-year
 156   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 157    "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"]
 158   "Array of strings giving the names of the Hebrew months in a common year.")
 159
 160 (defconst calendar-hebrew-month-name-array-leap-year
 161   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 162    "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"]
 163   "Array of strings giving the names of the Hebrew months in a leap year.")
 164
 165 ;;;###cal-autoload
 166 (defun calendar-hebrew-date-string (&optional date)
 167   "String of Hebrew date before sunset of Gregorian DATE.
 168 Defaults to today's date if DATE is not given.
 169 Driven by the variable `calendar-date-display-form'."
 170   (let* ((hebrew-date (calendar-hebrew-from-absolute
 171                        (calendar-absolute-from-gregorian
 172                         (or date (calendar-current-date)))))
 173          (calendar-month-name-array
 174           (if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date))
 175               calendar-hebrew-month-name-array-leap-year
 176             calendar-hebrew-month-name-array-common-year)))
 177     (calendar-date-string hebrew-date nil t)))
 178
 179 ;;;###cal-autoload
 180 (defun calendar-print-hebrew-date ()
 181   "Show the Hebrew calendar equivalent of the date under the cursor."
 182   (interactive)
 183   (message "Hebrew date (until sunset): %s"
 184            (calendar-hebrew-date-string (calendar-cursor-to-date t))))
 185
 186 (defun hebrew-calendar-yahrzeit (death-date year)
 187   "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
 188   (let ((death-day (extract-calendar-day death-date))
 189         (death-month (extract-calendar-month death-date))
 190         (death-year (extract-calendar-year death-date)))
 191     (cond
 192      ;; If it's Heshvan 30 it depends on the first anniversary; if
 193      ;; that was not Heshvan 30, use the day before Kislev 1.
 194      ((and (= death-month 8)
 195            (= death-day 30)
 196            (not (hebrew-calendar-long-heshvan-p (1+ death-year))))
 197       (1- (calendar-absolute-from-hebrew (list 9 1 year))))
 198      ;; If it's Kislev 30 it depends on the first anniversary; if that
 199      ;; was not Kislev 30, use the day before Teveth 1.
 200      ((and (= death-month 9)
 201            (= death-day 30)
 202            (hebrew-calendar-short-kislev-p (1+ death-year)))
 203       (1- (calendar-absolute-from-hebrew (list 10 1 year))))
 204      ;; If it's Adar II, use the same day in last month of year (Adar
 205      ;; or Adar II).
 206      ((= death-month 13)
 207       (calendar-absolute-from-hebrew
 208        (list (hebrew-calendar-last-month-of-year year) death-day year)))
 209      ;; If it's the 30th in Adar I and year is not a leap year (so
 210      ;; Adar has only 29 days), use the last day in Shevat.
 211      ((and (= death-day 30)
 212            (= death-month 12)
 213            (not (hebrew-calendar-leap-year-p year)))
 214       (calendar-absolute-from-hebrew (list 11 30 year)))
 215      ;; In all other cases, use the normal anniversary of the date of death.
 216      (t (calendar-absolute-from-hebrew
 217          (list death-month death-day year))))))
 218
 219 (defun calendar-hebrew-prompt-for-date ()
 220   "Ask for a Hebrew date."
 221   (let* ((today (calendar-current-date))
 222          (year (calendar-read
 223                 "Hebrew calendar year (>3760): "
 224                 (lambda (x) (> x 3760))
 225                 (int-to-string
 226                  (extract-calendar-year
 227                   (calendar-hebrew-from-absolute
 228                    (calendar-absolute-from-gregorian today))))))
 229          (month-array (if (hebrew-calendar-leap-year-p year)
 230                           calendar-hebrew-month-name-array-leap-year
 231                         calendar-hebrew-month-name-array-common-year))
 232          (completion-ignore-case t)
 233          (month (cdr (assoc-string
 234                       (completing-read
 235                        "Hebrew calendar month name: "
 236                        (mapcar 'list (append month-array nil))
 237                        (if (= year 3761)
 238                            (lambda (x)
 239                              (let ((m (cdr
 240                                        (assoc-string
 241                                         (car x)
 242                                         (calendar-make-alist month-array)
 243                                         t))))
 244                                (< 0
 245                                   (calendar-absolute-from-hebrew
 246                                    (list m
 247                                          (hebrew-calendar-last-day-of-month
 248                                           m year)
 249                                          year))))))
 250                        t)
 251                       (calendar-make-alist month-array 1) t)))
 252          (last (hebrew-calendar-last-day-of-month month year))
 253          (first (if (and (= year 3761) (= month 10))
 254                     18 1))
 255          (day (calendar-read
 256                (format "Hebrew calendar day (%d-%d): "
 257                        first last)
 258                (lambda (x) (and (<= first x) (<= x last))))))
 259     (list (list month day year))))
 260
 261 ;;;###cal-autoload
 262 (defun calendar-goto-hebrew-date (date &optional noecho)
 263   "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is non-nil."
 264   (interactive (calendar-hebrew-prompt-for-date))
 265   (calendar-goto-date (calendar-gregorian-from-absolute
 266                        (calendar-absolute-from-hebrew date)))
 267   (or noecho (calendar-print-hebrew-date)))
 268
 269 (defvar displayed-month)                ; from generate-calendar
 270 (defvar displayed-year)
 271
 272 ;;;###holiday-autoload
 273 (defun holiday-hebrew (month day string)
 274   "Holiday on MONTH, DAY (Hebrew) called STRING.
 275 If MONTH, DAY (Hebrew) is visible, the value returned is corresponding
 276 Gregorian date in the form of the list (((month day year) STRING)).  Returns
 277 nil if it is not visible in the current calendar window."
 278   ;; This test is only to speed things up a bit; it works fine without it.
 279   (if (memq displayed-month
 280             (list
 281              (if (< 11 month) (- month 11) (+ month 1))
 282              (if (< 10 month) (- month 10) (+ month 2))
 283              (if (<  9 month) (- month  9) (+ month 3))
 284              (if (<  8 month) (- month  8) (+ month 4))
 285              (if (<  7 month) (- month  7) (+ month 5))))
 286       (let ((m1 displayed-month)
 287             (y1 displayed-year)
 288             (m2 displayed-month)
 289             (y2 displayed-year)
 290             (year))
 291         (increment-calendar-month m1 y1 -1)
 292         (increment-calendar-month m2 y2 1)
 293         (let* ((start-date (calendar-absolute-from-gregorian
 294                             (list m1 1 y1)))
 295                (end-date (calendar-absolute-from-gregorian
 296                           (list m2 (calendar-last-day-of-month m2 y2) y2)))
 297                (hebrew-start (calendar-hebrew-from-absolute start-date))
 298                (hebrew-end (calendar-hebrew-from-absolute end-date))
 299                (hebrew-y1 (extract-calendar-year hebrew-start))
 300                (hebrew-y2 (extract-calendar-year hebrew-end)))
 301           (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
 302           (let ((date (calendar-gregorian-from-absolute
 303                        (calendar-absolute-from-hebrew
 304                         (list month day year)))))
 305             (if (calendar-date-is-visible-p date)
 306                 (list (list date string))))))))
 307
 308 ;; h-r-h-e should be called from holidays code.
 309 (declare-function holiday-filter-visible-calendar "holidays" (l))
 310
 311 ;;;###holiday-autoload
 312 (defun holiday-rosh-hashanah-etc ()
 313   "List of dates related to Rosh Hashanah, as visible in calendar window."
 314   (unless (or (< displayed-month 8)     ; none of the dates is visible
 315               (> displayed-month 11))
 316     (let* ((abs-r-h (calendar-absolute-from-hebrew
 317                      (list 7 1 (+ displayed-year 3761))))
 318            (mandatory
 319             (list
 320              (list (calendar-gregorian-from-absolute abs-r-h)
 321                    (format "Rosh HaShanah %d" (+ 3761 displayed-year)))
 322              (list (calendar-gregorian-from-absolute (+ abs-r-h 9))
 323                    "Yom Kippur")
 324              (list (calendar-gregorian-from-absolute (+ abs-r-h 14))
 325                    "Sukkot")
 326              (list (calendar-gregorian-from-absolute (+ abs-r-h 21))
 327                    "Shemini Atzeret")
 328              (list (calendar-gregorian-from-absolute (+ abs-r-h 22))
 329                    "Simchat Torah")))
 330            (optional
 331             (list
 332              (list (calendar-gregorian-from-absolute
 333                     (calendar-dayname-on-or-before 6 (- abs-r-h 4)))
 334                    "Selichot (night)")
 335              (list (calendar-gregorian-from-absolute (1- abs-r-h))
 336                    "Erev Rosh HaShanah")
 337              (list (calendar-gregorian-from-absolute (1+ abs-r-h))
 338                    "Rosh HaShanah (second day)")
 339              (list (calendar-gregorian-from-absolute
 340                     (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2)))
 341                    "Tzom Gedaliah")
 342              (list (calendar-gregorian-from-absolute
 343                     (calendar-dayname-on-or-before 6 (+ 7 abs-r-h)))
 344                    "Shabbat Shuvah")
 345              (list (calendar-gregorian-from-absolute (+ abs-r-h 8))
 346                    "Erev Yom Kippur")
 347              (list (calendar-gregorian-from-absolute (+ abs-r-h 13))
 348                    "Erev Sukkot")
 349              (list (calendar-gregorian-from-absolute (+ abs-r-h 15))
 350                    "Sukkot (second day)")
 351              (list (calendar-gregorian-from-absolute (+ abs-r-h 16))
 352                    "Hol Hamoed Sukkot (first day)")
 353              (list (calendar-gregorian-from-absolute (+ abs-r-h 17))
 354                    "Hol Hamoed Sukkot (second day)")
 355              (list (calendar-gregorian-from-absolute (+ abs-r-h 18))
 356                    "Hol Hamoed Sukkot (third day)")
 357              (list (calendar-gregorian-from-absolute (+ abs-r-h 19))
 358                    "Hol Hamoed Sukkot (fourth day)")
 359              (list (calendar-gregorian-from-absolute (+ abs-r-h 20))
 360                    "Hoshanah Rabbah")))
 361            (output-list
 362             (holiday-filter-visible-calendar mandatory)))
 363       (if all-hebrew-calendar-holidays
 364           (setq output-list
 365                 (append
 366                  (holiday-filter-visible-calendar optional)
 367                  output-list)))
 368       output-list)))
 369
 370 ;;;###holiday-autoload
 371 (defun holiday-hanukkah ()
 372   "List of dates related to Hanukkah, as visible in calendar window."
 373   ;; This test is only to speed things up a bit, it works fine without it.
 374   (if (memq displayed-month
 375             '(10 11 12 1 2))
 376       (let ((m displayed-month)
 377             (y displayed-year))
 378         (increment-calendar-month m y 1)
 379         (let* ((h-y (extract-calendar-year
 380                      (calendar-hebrew-from-absolute
 381                       (calendar-absolute-from-gregorian
 382                        (list m (calendar-last-day-of-month m y) y)))))
 383                (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y))))
 384           (holiday-filter-visible-calendar
 385            (list
 386             (list (calendar-gregorian-from-absolute (1- abs-h))
 387                   "Erev Hanukkah")
 388             (list (calendar-gregorian-from-absolute abs-h)
 389                   "Hanukkah (first day)")
 390             (list (calendar-gregorian-from-absolute (1+ abs-h))
 391                   "Hanukkah (second day)")
 392             (list (calendar-gregorian-from-absolute (+ abs-h 2))
 393                   "Hanukkah (third day)")
 394             (list (calendar-gregorian-from-absolute (+ abs-h 3))
 395                   "Hanukkah (fourth day)")
 396             (list (calendar-gregorian-from-absolute (+ abs-h 4))
 397                   "Hanukkah (fifth day)")
 398             (list (calendar-gregorian-from-absolute (+ abs-h 5))
 399                   "Hanukkah (sixth day)")
 400             (list (calendar-gregorian-from-absolute (+ abs-h 6))
 401                   "Hanukkah (seventh day)")
 402             (list (calendar-gregorian-from-absolute (+ abs-h 7))
 403                   "Hanukkah (eighth day)")))))))
 404
 405 ;;;###holiday-autoload
 406 (defun holiday-passover-etc ()
 407   "List of dates related to Passover, as visible in calendar window."
 408   (unless (< 7 displayed-month)         ; 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   (unless (or (< displayed-month 5)     ; none of the dates is visible
 493               (> displayed-month 9))
 494     (let ((abs-t-a (calendar-absolute-from-hebrew
 495                     (list 5 9 (+ displayed-year 3760)))))
 496       (holiday-filter-visible-calendar
 497        (list
 498         (list (calendar-gregorian-from-absolute
 499                (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
 500               "Tzom Tammuz")
 501         (list (calendar-gregorian-from-absolute
 502                (calendar-dayname-on-or-before 6 abs-t-a))
 503               "Shabbat Hazon")
 504         (list (calendar-gregorian-from-absolute
 505                (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a))
 506               "Tisha B'Av")
 507         (list (calendar-gregorian-from-absolute
 508                (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
 509               "Shabbat Nahamu"))))))
 510
 511 (autoload 'diary-list-entries-1 "diary-lib")
 512
 513 ;;;###diary-autoload
 514 (defun list-hebrew-diary-entries ()
 515   "Add any Hebrew date entries from the diary file to `diary-entries-list'.
 516 Hebrew date diary entries must be prefaced by `hebrew-diary-entry-symbol'
 517 \(normally an `H').  The same diary date forms govern the style
 518 of the Hebrew calendar entries, except that the Hebrew month
 519 names must be spelled in full.  The Hebrew months are numbered
 520 from 1 to 13 with Nisan being 1, 12 being Adar I and 13 being
 521 Adar II; you must use `Adar I' if you want Adar of a common
 522 Hebrew year.  If a Hebrew date diary entry begins with
 523 `diary-nonmarking-symbol', the entry will appear in the diary
 524 listing, but will not be marked in the calendar.  This function
 525 is provided for use with `nongregorian-diary-listing-hook'."
 526   (diary-list-entries-1 calendar-hebrew-month-name-array-leap-year
 527                         hebrew-diary-entry-symbol
 528                         'calendar-hebrew-from-absolute))
 529
 530 (autoload 'calendar-mark-complex "diary-lib")
 531
 532 ;;;###diary-autoload
 533 (defun mark-hebrew-calendar-date-pattern (month day year &optional color)
 534   "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
 535 A value of 0 in any position is a wildcard.  Optional argument COLOR is
 536 passed to `mark-visible-calendar-date' as MARK."
 537   ;; FIXME not the same as the Bahai and Islamic cases, so can't use
 538   ;; calendar-mark-1.
 539   (save-excursion
 540     (set-buffer calendar-buffer)
 541     (if (and (not (zerop month)) (not (zerop day)))
 542         (if (not (zerop year))
 543             ;; Fully specified Hebrew date.
 544             (let ((date (calendar-gregorian-from-absolute
 545                          (calendar-absolute-from-hebrew
 546                           (list month day year)))))
 547               (if (calendar-date-is-visible-p date)
 548                   (mark-visible-calendar-date date color)))
 549           ;; Month and day in any year--this taken from the holiday stuff.
 550           ;; This test is only to speed things up a bit, it works
 551           ;; fine without it.
 552           (if (memq displayed-month
 553                     (list
 554                      (if (< 11 month) (- month 11) (+ month 1))
 555                      (if (< 10 month) (- month 10) (+ month 2))
 556                      (if (<  9 month) (- month  9) (+ month 3))
 557                      (if (<  8 month) (- month  8) (+ month 4))
 558                      (if (<  7 month) (- month  7) (+ month 5))))
 559               (let ((m1 displayed-month)
 560                     (y1 displayed-year)
 561                     (m2 displayed-month)
 562                     (y2 displayed-year)
 563                     year)
 564                 (increment-calendar-month m1 y1 -1)
 565                 (increment-calendar-month m2 y2 1)
 566                 (let* ((start-date (calendar-absolute-from-gregorian
 567                                     (list m1 1 y1)))
 568                        (end-date (calendar-absolute-from-gregorian
 569                                   (list m2
 570                                         (calendar-last-day-of-month m2 y2)
 571                                         y2)))
 572                        (hebrew-start (calendar-hebrew-from-absolute start-date))
 573                        (hebrew-end (calendar-hebrew-from-absolute end-date))
 574                        (hebrew-y1 (extract-calendar-year hebrew-start))
 575                        (hebrew-y2 (extract-calendar-year hebrew-end)))
 576                   (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
 577                   (let ((date (calendar-gregorian-from-absolute
 578                                (calendar-absolute-from-hebrew
 579                                 (list month day year)))))
 580                     (if (calendar-date-is-visible-p date)
 581                         (mark-visible-calendar-date date color)))))))
 582       (calendar-mark-complex month day year
 583                              'calendar-hebrew-from-absolute color))))
 584
 585 (autoload 'diary-mark-entries-1 "diary-lib")
 586
 587 ;;;###diary-autoload
 588 (defun mark-hebrew-diary-entries ()
 589   "Mark days in the calendar window that have Hebrew date diary entries.
 590 Marks each entry in `diary-file' (or included files) visible in the calendar
 591 window.  See `list-hebrew-diary-entries' for more information."
 592   (diary-mark-entries-1 calendar-hebrew-month-name-array-leap-year
 593                         hebrew-diary-entry-symbol
 594                         'calendar-hebrew-from-absolute
 595                         'mark-hebrew-calendar-date-pattern))
 596
 597 ;;;###cal-autoload
 598 (defun insert-hebrew-diary-entry (arg)
 599   "Insert a diary entry.
 600 For the Hebrew date corresponding to the date indicated by point.
 601 Prefix argument ARG makes the entry nonmarking."
 602   (interactive "P")
 603   (let ((calendar-month-name-array calendar-hebrew-month-name-array-leap-year))
 604     (make-diary-entry
 605      (concat hebrew-diary-entry-symbol
 606              (calendar-date-string
 607               (calendar-hebrew-from-absolute
 608                (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))
 609               nil t))
 610      arg)))
 611
 612 ;;;###cal-autoload
 613 (defun insert-monthly-hebrew-diary-entry (arg)
 614   "Insert a monthly diary entry.
 615 For the day of the Hebrew month corresponding to the date indicated by point.
 616 Prefix argument ARG makes the entry nonmarking."
 617   (interactive "P")
 618   (let ((calendar-date-display-form (if european-calendar-style
 619                                         '(day " * ")
 620                                       '("* " day )))
 621         (calendar-month-name-array calendar-hebrew-month-name-array-leap-year))
 622     (make-diary-entry
 623      (concat hebrew-diary-entry-symbol
 624              (calendar-date-string
 625               (calendar-hebrew-from-absolute
 626                (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))
 627      arg)))
 628
 629 ;;;###cal-autoload
 630 (defun insert-yearly-hebrew-diary-entry (arg)
 631   "Insert an annual diary entry.
 632 For the day of the Hebrew year corresponding to the date indicated by point.
 633 Prefix argument ARG makes the entry nonmarking."
 634   (interactive "P")
 635   (let ((calendar-date-display-form (if european-calendar-style
 636                                          '(day " " monthname)
 637                                        '(monthname " " day)))
 638          (calendar-month-name-array calendar-hebrew-month-name-array-leap-year))
 639     (make-diary-entry
 640      (concat hebrew-diary-entry-symbol
 641              (calendar-date-string
 642               (calendar-hebrew-from-absolute
 643                (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))
 644      arg)))
 645
 646 ;;;###autoload
 647 (defun list-yahrzeit-dates (death-date start-year end-year)
 648   "List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
 649 When called interactively from the calendar window, the date of death is taken
 650 from the cursor position."
 651   (interactive
 652    (let* ((death-date
 653            (if (equal (current-buffer) (get-buffer calendar-buffer))
 654                (calendar-cursor-to-date)
 655              (let* ((today (calendar-current-date))
 656                     (year (calendar-read
 657                            "Year of death (>0): "
 658                            (lambda (x) (> x 0))
 659                            (int-to-string (extract-calendar-year today))))
 660                     (month-array calendar-month-name-array)
 661                     (completion-ignore-case t)
 662                     (month (cdr (assoc-string
 663                                  (completing-read
 664                                   "Month of death (name): "
 665                                   (mapcar 'list (append month-array nil))
 666                                   nil t)
 667                                  (calendar-make-alist month-array 1) t)))
 668                     (last (calendar-last-day-of-month month year))
 669                     (day (calendar-read
 670                           (format "Day of death (1-%d): " last)
 671                           (lambda (x) (and (< 0 x) (<= x last))))))
 672                (list month day year))))
 673           (death-year (extract-calendar-year death-date))
 674           (start-year (calendar-read
 675                        (format "Starting year of Yahrzeit table (>%d): "
 676                                death-year)
 677                        (lambda (x) (> x death-year))
 678                        (int-to-string (1+ death-year))))
 679           (end-year (calendar-read
 680                      (format "Ending year of Yahrzeit table (>=%d): "
 681                              start-year)
 682                      (lambda (x) (>= x start-year)))))
 683      (list death-date start-year end-year)))
 684   (message "Computing Yahrzeits...")
 685   (let* ((h-date (calendar-hebrew-from-absolute
 686                   (calendar-absolute-from-gregorian death-date)))
 687          (h-month (extract-calendar-month h-date))
 688          (h-day (extract-calendar-day h-date))
 689          (h-year (extract-calendar-year h-date)))
 690     (calendar-in-read-only-buffer cal-hebrew-yahrzeit-buffer
 691       (calendar-set-mode-line
 692        (format "Yahrzeit dates for %s = %s"
 693                (calendar-date-string death-date)
 694                (let ((calendar-month-name-array
 695                       (if (hebrew-calendar-leap-year-p h-year)
 696                           calendar-hebrew-month-name-array-leap-year
 697                         calendar-hebrew-month-name-array-common-year)))
 698                  (calendar-date-string h-date nil t))))
 699       (calendar-for-loop i from start-year to end-year do
 700         (insert
 701          (calendar-date-string
 702           (calendar-gregorian-from-absolute
 703            (hebrew-calendar-yahrzeit
 704             h-date
 705             (extract-calendar-year
 706              (calendar-hebrew-from-absolute
 707               (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n")))
 708     (message "Computing Yahrzeits...done")))
 709
 710 (defvar date)
 711
 712 ;; To be called from list-sexp-diary-entries, where DATE is bound.
 713 ;;;###diary-autoload
 714 (defun diary-hebrew-date ()
 715   "Hebrew calendar equivalent of date diary entry."
 716   (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
 717
 718 ;;;###diary-autoload
 719 (defun diary-omer (&optional mark)
 720   "Omer count diary entry.
 721 Entry applies if date is within 50 days after Passover.
 722
 723 An optional parameter MARK specifies a face or single-character string to
 724 use when highlighting the day in the calendar."
 725   (let* ((passover
 726           (calendar-absolute-from-hebrew
 727            (list 1 15 (+ (extract-calendar-year date) 3760))))
 728          (omer (- (calendar-absolute-from-gregorian date) passover))
 729          (week (/ omer 7))
 730          (day (% omer 7)))
 731     (if (and (> omer 0) (< omer 50))
 732         (cons mark
 733               (format "Day %d%s of the omer (until sunset)"
 734                       omer
 735                       (if (zerop week)
 736                           ""
 737                         (format ", that is, %d week%s%s"
 738                                 week
 739                                 (if (= week 1) "" "s")
 740                                 (if (zerop day)
 741                                     ""
 742                                   (format " and %d day%s"
 743                                           day (if (= day 1) "" "s"))))))))))
 744
 745 (defvar entry)
 746
 747 ;;;###diary-autoload
 748 (defun diary-yahrzeit (death-month death-day death-year &optional mark)
 749   "Yahrzeit diary entry--entry applies if date is Yahrzeit or the day before.
 750 Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
 751 to be the name of the person.  Date of death is on the *civil* calendar;
 752 although the date of death is specified by the civil calendar, the proper
 753 Hebrew calendar Yahrzeit is determined.  If `european-calendar-style' is
 754 non-nil, the order of the parameters is changed to DEATH-DAY, DEATH-MONTH,
 755 DEATH-YEAR.
 756
 757 An optional parameter MARK specifies a face or single-character string to
 758 use when highlighting the day in the calendar."
 759   (let* ((h-date (calendar-hebrew-from-absolute
 760                   (calendar-absolute-from-gregorian
 761                    (if european-calendar-style
 762                        (list death-day death-month death-year)
 763                      (list death-month death-day death-year)))))
 764          (h-month (extract-calendar-month h-date))
 765          (h-day (extract-calendar-day h-date))
 766          (h-year (extract-calendar-year h-date))
 767          (d (calendar-absolute-from-gregorian date))
 768          (yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
 769          (diff (- yr h-year))
 770          (y (hebrew-calendar-yahrzeit h-date yr)))
 771     (if (and (> diff 0) (or (= y d) (= y (1+ d))))
 772         (cons mark
 773               (format "Yahrzeit of %s%s: %d%s anniversary"
 774                       entry
 775                       (if (= y d) "" " (evening)")
 776                       diff
 777                       (cond ((= (% diff 10) 1) "st")
 778                             ((= (% diff 10) 2) "nd")
 779                             ((= (% diff 10) 3) "rd")
 780                             (t "th")))))))
 781
 782 ;;;###diary-autoload
 783 (defun diary-rosh-hodesh (&optional mark)
 784   "Rosh Hodesh diary entry.
 785 Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.
 786
 787 An optional parameter MARK specifies a face or single-character string to
 788 use when highlighting the day in the calendar."
 789   (let* ((d (calendar-absolute-from-gregorian date))
 790          (h-date (calendar-hebrew-from-absolute d))
 791          (h-month (extract-calendar-month h-date))
 792          (h-day (extract-calendar-day h-date))
 793          (h-year (extract-calendar-year h-date))
 794          (leap-year (hebrew-calendar-leap-year-p h-year))
 795          (last-day (hebrew-calendar-last-day-of-month h-month h-year))
 796          (h-month-names
 797           (if leap-year
 798               calendar-hebrew-month-name-array-leap-year
 799             calendar-hebrew-month-name-array-common-year))
 800          (this-month (aref h-month-names (1- h-month)))
 801          (h-yesterday (extract-calendar-day
 802                        (calendar-hebrew-from-absolute (1- d)))))
 803     (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
 804         (cons mark
 805               (format
 806                "Rosh Hodesh %s"
 807                (if (= h-day 30)
 808                    (format
 809                     "%s (first day)"
 810                     ;; Next month must be in the same year since this
 811                     ;; month can't be the last month of the year since
 812                     ;; it has 30 days
 813                     (aref h-month-names h-month))
 814                  (if (= h-yesterday 30)
 815                      (format "%s (second day)" this-month)
 816                    this-month))))
 817       (if (= (% d 7) 6)        ; Saturday--check for Shabbat Mevarchim
 818           (cons mark
 819                 (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
 820                        (format "Mevarchim Rosh Hodesh %s (%s)"
 821                                (aref h-month-names
 822                                      (if (= h-month
 823                                             (hebrew-calendar-last-month-of-year
 824                                              h-year))
 825                                          0 h-month))
 826                                (aref calendar-day-name-array (- 29 h-day))))
 827                       ((and (< h-day 30) (> h-day 22) (= 30 last-day))
 828                        (format "Mevarchim Rosh Hodesh %s (%s-%s)"
 829                                (aref h-month-names h-month)
 830                                (if (= h-day 29)
 831                                    "tomorrow"
 832                                  (aref calendar-day-name-array (- 29 h-day)))
 833                                (aref calendar-day-name-array
 834                                      (% (- 30 h-day) 7))))))
 835         (if (and (= h-day 29) (/= h-month 6))
 836             (cons mark
 837                   (format "Erev Rosh Hodesh %s"
 838                           (aref h-month-names
 839                                 (if (= h-month
 840                                        (hebrew-calendar-last-month-of-year
 841                                         h-year))
 842                                     0 h-month)))))))))
 843
 844 (defconst hebrew-calendar-parashiot-names
 845   ["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"
 846    "Vayetze"     "Vayishlah" "Vayeshev"   "Mikketz"   "Vayiggash"   "Vayhi"
 847    "Shemoth"     "Vaera"     "Bo"         "Beshallah" "Yithro"      "Mishpatim"
 848    "Terumah"     "Tetzavveh" "Ki Tissa"   "Vayakhel"  "Pekudei"     "Vayikra"
 849    "Tzav"        "Shemini"   "Tazria"     "Metzora"   "Aharei Moth" "Kedoshim"
 850    "Emor"        "Behar"     "Behukkotai" "Bemidbar"  "Naso"      "Behaalot'cha"
 851    "Shelah L'cha" "Korah"    "Hukkath"    "Balak"     "Pinhas"      "Mattoth"
 852    "Masei"       "Devarim"   "Vaethanan"  "Ekev"      "Reeh"        "Shofetim"
 853    "Ki Tetze"    "Ki Tavo"   "Nitzavim"   "Vayelech"  "Haazinu"]
 854   "The names of the parashiot in the Torah.")
 855
 856 (defun hebrew-calendar-parasha-name (p)
 857   "Name(s) corresponding to parasha P."
 858   (if (arrayp p)                        ; combined parasha
 859       (format "%s/%s"
 860               (aref hebrew-calendar-parashiot-names (aref p 0))
 861               (aref hebrew-calendar-parashiot-names (aref p 1)))
 862     (aref hebrew-calendar-parashiot-names p)))
 863
 864 ;; Following 14 constants are used in diary-parasha (intern).
 865
 866 ;; The seven ordinary year types (keviot).
 867 (defconst hebrew-calendar-year-Saturday-incomplete-Sunday
 868   [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]
 869        23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
 870        43 44 45 46 47 48 49 50]
 871   "The structure of the parashiot.
 872 Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have
 873 29 days), and has Passover start on Sunday.")
 874
 875 (defconst hebrew-calendar-year-Saturday-complete-Tuesday
 876   [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]
 877        23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
 878        43 44 45 46 47 48 49 [50 51]]
 879   "The structure of the parashiot.
 880 Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
 881 have 30 days), and has Passover start on Tuesday.")
 882
 883 (defconst hebrew-calendar-year-Monday-incomplete-Tuesday
 884   [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]
 885       23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
 886       43 44 45 46 47 48 49 [50 51]]
 887   "The structure of the parashiot.
 888 Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
 889 have 29 days), and has Passover start on Tuesday.")
 890
 891 (defconst hebrew-calendar-year-Monday-complete-Thursday
 892   [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]
 893       23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
 894       (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
 895   "The structure of the parashiot.
 896 Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
 897 30 days), and has Passover start on Thursday.")
 898
 899 (defconst hebrew-calendar-year-Tuesday-regular-Thursday
 900   [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]
 901       23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
 902       (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
 903   "The structure of the parashiot.
 904 Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
 905 Kislev has 30 days), and has Passover start on Thursday.")
 906
 907 (defconst hebrew-calendar-year-Thursday-regular-Saturday
 908   [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
 909       24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30)
 910       (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48
 911       49 50]
 912   "The structure of the parashiot.
 913 Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and
 914 Kislev has 30 days), and has Passover start on Saturday.")
 915
 916 (defconst hebrew-calendar-year-Thursday-complete-Sunday
 917   [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
 918       23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
 919       43 44 45 46 47 48 49 50]
 920   "The structure of the parashiot.
 921 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each
 922 have 30 days), and has Passover start on Sunday.")
 923
 924 ;; The seven leap year types (keviot).
 925 (defconst hebrew-calendar-year-Saturday-incomplete-Tuesday
 926   [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
 927        23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42]
 928        43 44 45 46 47 48 49 [50 51]]
 929   "The structure of the parashiot.
 930 Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each
 931 have 29 days), and has Passover start on Tuesday.")
 932
 933 (defconst hebrew-calendar-year-Saturday-complete-Thursday
 934   [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
 935        23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
 936        (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
 937   "The structure of the parashiot.
 938 Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
 939 have 30 days), and has Passover start on Thursday.")
 940
 941 (defconst hebrew-calendar-year-Monday-incomplete-Thursday
 942   [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
 943       23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
 944       (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
 945   "The structure of the parashiot.
 946 Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
 947 have 29 days), and has Passover start on Thursday.")
 948
 949 (defconst hebrew-calendar-year-Monday-complete-Saturday
 950   [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
 951       23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
 952       (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
 953       (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
 954   "The structure of the parashiot.
 955 Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
 956 30 days), and has Passover start on Saturday.")
 957
 958 (defconst hebrew-calendar-year-Tuesday-regular-Saturday
 959   [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
 960       23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
 961       (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
 962       (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
 963   "The structure of the parashiot.
 964 Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
 965 Kislev has 30 days), and has Passover start on Saturday.")
 966
 967 (defconst hebrew-calendar-year-Thursday-incomplete-Sunday
 968   [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
 969       23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
 970       43 44 45 46 47 48 49 50]
 971   "The structure of the parashiot.
 972 Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both
 973 have 29 days), and has Passover start on Sunday.")
 974
 975 (defconst hebrew-calendar-year-Thursday-complete-Tuesday
 976   [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
 977       23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
 978       43 44 45 46 47 48 49 [50 51]]
 979   "The structure of the parashiot.
 980 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
 981 have 30 days), and has Passover start on Tuesday.")
 982
 983 ;;;###diary-autoload
 984 (defun diary-parasha (&optional mark)
 985   "Parasha diary entry--entry applies if date is a Saturday.
 986 An optional parameter MARK specifies a face or single-character string to
 987 use when highlighting the day in the calendar."
 988   (let ((d (calendar-absolute-from-gregorian date)))
 989     (if (= (% d 7) 6)                   ; Saturday
 990         (let* ((h-year (extract-calendar-year
 991                         (calendar-hebrew-from-absolute d)))
 992                (rosh-hashanah
 993                 (calendar-absolute-from-hebrew (list 7 1 h-year)))
 994                (passover
 995                 (calendar-absolute-from-hebrew (list 1 15 h-year)))
 996                (rosh-hashanah-day
 997                 (aref calendar-day-name-array (% rosh-hashanah 7)))
 998                (passover-day
 999                 (aref calendar-day-name-array (% passover 7)))
1000                (long-h (hebrew-calendar-long-heshvan-p h-year))
1001                (short-k (hebrew-calendar-short-kislev-p h-year))
1002                (type (cond ((and long-h (not short-k)) "complete")
1003                            ((and (not long-h) short-k) "incomplete")
1004                            (t "regular")))
1005                (year-format
1006                 (symbol-value
1007                  (intern (format "hebrew-calendar-year-%s-%s-%s" ; keviah
1008                                  rosh-hashanah-day type passover-day))))
1009                (first-saturday            ; of Hebrew year
1010                 (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))
1011                (saturday             ; which Saturday of the Hebrew year
1012                 (/ (- d first-saturday) 7))
1013                (parasha (aref year-format saturday)))
1014           (if parasha
1015               (cons mark
1016                     (format
1017                      "Parashat %s"
1018                      (if (listp parasha) ; Israel differs from diaspora
1019                          (if (car parasha)
1020                              (format "%s (diaspora), %s (Israel)"
1021                                      (hebrew-calendar-parasha-name
1022                                       (car parasha))
1023                                      (hebrew-calendar-parasha-name
1024                                       (cdr parasha)))
1025                            (format "%s (Israel)"
1026                                    (hebrew-calendar-parasha-name
1027                                     (cdr parasha))))
1028                        (hebrew-calendar-parasha-name parasha)))))))))
1029
1030 (provide 'cal-hebrew)
1031
1032 ;; arch-tag: aaab6718-7712-42ac-a32d-28fe1f944f3c
1033 ;;; cal-hebrew.el ends here