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