cal-hebrew.el 51.5 KB
Newer Older
1
;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
Edward M. Reingold's avatar
Edward M. Reingold committed
2

3 4
;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;;   2008  Free Software Foundation, Inc.
Edward M. Reingold's avatar
Edward M. Reingold committed
5

Edward M. Reingold's avatar
Edward M. Reingold committed
6
;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
7
;;         Edward M. Reingold <reingold@cs.uiuc.edu>
8
;; Maintainer: Glenn Morris <rgm@gnu.org>
Edward M. Reingold's avatar
Edward M. Reingold committed
9 10 11 12 13 14 15
;; Keywords: calendar
;; Human-Keywords: Hebrew calendar, calendar, diary

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; 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)
Edward M. Reingold's avatar
Edward M. Reingold committed
17 18 19 20 21 22 23 24
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
26 27
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Edward M. Reingold's avatar
Edward M. Reingold committed
28 29 30

;;; Commentary:

31
;; See calendar.el.
32

Edward M. Reingold's avatar
Edward M. Reingold committed
33 34
;;; Code:

35
(require 'calendar)
Edward M. Reingold's avatar
Edward M. Reingold committed
36

37 38 39 40 41 42 43 44 45 46 47 48
(defcustom diary-hebrew-sabbath-candles-minutes 18
  "Number of minutes before sunset for sabbath candle lighting.
Used by `diary-hebrew-sabbath-candles'."
  :group 'diary
  :type 'integer
  :version "21.1")

(define-obsolete-variable-alias 'diary-sabbath-candles-minutes
  'diary-hebrew-sabbath-candles-minutes "23.1")

;; End of user options.

49
(defun calendar-hebrew-leap-year-p (year)
Glenn Morris's avatar
Glenn Morris committed
50
  "Non-nil if YEAR is a Hebrew calendar leap year."
Edward M. Reingold's avatar
Edward M. Reingold committed
51 52
  (< (% (1+ (* 7 year)) 19) 7))

53
(defun calendar-hebrew-last-month-of-year (year)
Edward M. Reingold's avatar
Edward M. Reingold committed
54
  "The last month of the Hebrew calendar YEAR."
55
  (if (calendar-hebrew-leap-year-p year)
Edward M. Reingold's avatar
Edward M. Reingold committed
56 57 58
      13
    12))

59
(defun calendar-hebrew-elapsed-days (year)
60 61
  "Days to mean conjunction of Tishri of Hebrew YEAR.
Measured from Sunday before start of Hebrew calendar."
Edward M. Reingold's avatar
Edward M. Reingold committed
62
  (let* ((months-elapsed
Glenn Morris's avatar
Glenn Morris committed
63 64 65
          (+ (* 235 (/ (1- year) 19)) ; months in complete cycles so far
             (* 12 (% (1- year) 19))  ; regular months in this cycle
             (/ (1+ (* 7 (% (1- year) 19))) 19))) ; leap months this cycle
Edward M. Reingold's avatar
Edward M. Reingold committed
66 67 68 69 70
         (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
         (hours-elapsed (+ 5
                           (* 12 months-elapsed)
                           (* 793 (/ months-elapsed 1080))
                           (/ parts-elapsed 1080)))
Glenn Morris's avatar
Glenn Morris committed
71
         (parts                         ; conjunction parts
Edward M. Reingold's avatar
Edward M. Reingold committed
72
          (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
Glenn Morris's avatar
Glenn Morris committed
73
         (day                           ; conjunction day
Edward M. Reingold's avatar
Edward M. Reingold committed
74 75
          (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
         (alternative-day
Glenn Morris's avatar
Glenn Morris committed
76
          (if (or (>= parts 19440) ; if the new moon is at or after midday
Glenn Morris's avatar
Glenn Morris committed
77
                  (and (= (% day 7) 2)  ; ...or is on a Tuesday...
Glenn Morris's avatar
Glenn Morris committed
78
                       (>= parts 9924) ; at 9 hours, 204 parts or later...
Glenn Morris's avatar
Glenn Morris committed
79
                       ;; of a common year...
80
                       (not (calendar-hebrew-leap-year-p year)))
Glenn Morris's avatar
Glenn Morris committed
81
                  (and (= (% day 7) 1)  ; ...or is on a Monday...
Glenn Morris's avatar
Glenn Morris committed
82
                       (>= parts 16789) ; at 15 hours, 589 parts or later...
Glenn Morris's avatar
Glenn Morris committed
83
                       ;; at the end of a leap year.
84
                       (calendar-hebrew-leap-year-p (1- year))))
Glenn Morris's avatar
Glenn Morris committed
85
              ;; Then postpone Rosh HaShanah one day.
Edward M. Reingold's avatar
Edward M. Reingold committed
86
              (1+ day)
Glenn Morris's avatar
Glenn Morris committed
87
            ;; Else:
Edward M. Reingold's avatar
Edward M. Reingold committed
88
            day)))
Glenn Morris's avatar
Glenn Morris committed
89 90
    ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
    (if (memq (% alternative-day 7) (list 0 3 5))
Glenn Morris's avatar
Glenn Morris committed
91
        ;; Then postpone it one (more) day and return.
Edward M. Reingold's avatar
Edward M. Reingold committed
92
        (1+ alternative-day)
Glenn Morris's avatar
Glenn Morris committed
93
      ;; Else return.
Edward M. Reingold's avatar
Edward M. Reingold committed
94 95
      alternative-day)))

96
(defun calendar-hebrew-days-in-year (year)
Edward M. Reingold's avatar
Edward M. Reingold committed
97
  "Number of days in Hebrew YEAR."
98 99
  (- (calendar-hebrew-elapsed-days (1+ year))
     (calendar-hebrew-elapsed-days year)))
Edward M. Reingold's avatar
Edward M. Reingold committed
100

101
(defun calendar-hebrew-long-heshvan-p (year)
Glenn Morris's avatar
Glenn Morris committed
102
  "Non-nil if Heshvan is long in Hebrew YEAR."
103
  (= (% (calendar-hebrew-days-in-year year) 10) 5))
Edward M. Reingold's avatar
Edward M. Reingold committed
104

105
(defun calendar-hebrew-short-kislev-p (year)
Glenn Morris's avatar
Glenn Morris committed
106
  "Non-nil if Kislev is short in Hebrew YEAR."
107
  (= (% (calendar-hebrew-days-in-year year) 10) 3))
Edward M. Reingold's avatar
Edward M. Reingold committed
108

109
(defun calendar-hebrew-last-day-of-month (month year)
110 111
  "The last day of MONTH in YEAR."
  (if (or (memq month (list 2 4 6 10 13))
112 113 114
          (and (= month 12) (not (calendar-hebrew-leap-year-p year)))
          (and (= month 8) (not (calendar-hebrew-long-heshvan-p year)))
          (and (= month 9) (calendar-hebrew-short-kislev-p year)))
115 116 117
      29
    30))

118
(defun calendar-hebrew-to-absolute (date)
Edward M. Reingold's avatar
Edward M. Reingold committed
119 120 121
  "Absolute date of Hebrew DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
122 123 124
  (let ((month (extract-calendar-month date))
        (day (extract-calendar-day date))
        (year (extract-calendar-year date)))
Glenn Morris's avatar
Glenn Morris committed
125 126 127
    (+ day                              ; days so far this month
       (if (< month 7)                  ; before Tishri
           ;; Then add days in prior months this year before and after Nisan.
Edward M. Reingold's avatar
Edward M. Reingold committed
128
           (+ (calendar-sum
129 130
               m 7 (<= m (calendar-hebrew-last-month-of-year year))
               (calendar-hebrew-last-day-of-month m year))
Edward M. Reingold's avatar
Edward M. Reingold committed
131 132
              (calendar-sum
               m 1 (< m month)
133
               (calendar-hebrew-last-day-of-month m year)))
Glenn Morris's avatar
Glenn Morris committed
134
         ;; Else add days in prior months this year.
Edward M. Reingold's avatar
Edward M. Reingold committed
135 136
         (calendar-sum
          m 7 (< m month)
137 138
          (calendar-hebrew-last-day-of-month m year)))
       (calendar-hebrew-elapsed-days year) ; days in prior years
Glenn Morris's avatar
Glenn Morris committed
139
       -1373429)))               ; days elapsed before absolute date 1
Edward M. Reingold's avatar
Edward M. Reingold committed
140

141 142 143
(define-obsolete-function-alias 'calendar-absolute-from-hebrew
  'calendar-hebrew-to-absolute "23.1")

144 145 146 147 148
(defun calendar-hebrew-from-absolute (date)
  "Compute the Hebrew date (month day year) corresponding to absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
  (let* ((greg-date (calendar-gregorian-from-absolute date))
149
         (year (+ 3760 (extract-calendar-year greg-date)))
150
         (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
Glenn Morris's avatar
Glenn Morris committed
151
                      (1- (extract-calendar-month greg-date))))
152
         (length (progn
153
                   (while (>= date (calendar-hebrew-to-absolute
154 155
                                    (list 7 1 (1+ year))))
                     (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 163
                     year)))
      (setq month (1+ (% month length))))
164
    (setq day (1+
165
               (- date (calendar-hebrew-to-absolute (list month 1 year)))))
166 167
    (list month day year)))

168
(defconst calendar-hebrew-month-name-array-common-year
Edward M. Reingold's avatar
Edward M. Reingold committed
169
  ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
170
   "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"]
Glenn Morris's avatar
Glenn Morris committed
171
  "Array of strings giving the names of the Hebrew months in a common year.")
Edward M. Reingold's avatar
Edward M. Reingold committed
172

173
(defconst calendar-hebrew-month-name-array-leap-year
Edward M. Reingold's avatar
Edward M. Reingold committed
174
  ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
175
   "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"]
Glenn Morris's avatar
Glenn Morris committed
176
  "Array of strings giving the names of the Hebrew months in a leap year.")
Edward M. Reingold's avatar
Edward M. Reingold committed
177

178
;;;###cal-autoload
Edward M. Reingold's avatar
Edward M. Reingold committed
179 180 181 182 183 184 185 186
(defun calendar-hebrew-date-string (&optional date)
  "String of Hebrew date before sunset of Gregorian DATE.
Defaults to today's date if DATE is not given.
Driven by the variable `calendar-date-display-form'."
  (let* ((hebrew-date (calendar-hebrew-from-absolute
                       (calendar-absolute-from-gregorian
                        (or date (calendar-current-date)))))
         (calendar-month-name-array
187
          (if (calendar-hebrew-leap-year-p (extract-calendar-year hebrew-date))
Edward M. Reingold's avatar
Edward M. Reingold committed
188 189 190 191
              calendar-hebrew-month-name-array-leap-year
            calendar-hebrew-month-name-array-common-year)))
    (calendar-date-string hebrew-date nil t)))

192
;;;###cal-autoload
193
(defun calendar-hebrew-print-date ()
Edward M. Reingold's avatar
Edward M. Reingold committed
194 195 196 197 198
  "Show the Hebrew calendar equivalent of the date under the cursor."
  (interactive)
  (message "Hebrew date (until sunset): %s"
           (calendar-hebrew-date-string (calendar-cursor-to-date t))))

199 200 201 202
(define-obsolete-function-alias 'calendar-print-hebrew-date
  'calendar-hebrew-print-date "23.1")

(defun calendar-hebrew-yahrzeit (death-date year)
Edward M. Reingold's avatar
Edward M. Reingold committed
203
  "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
204 205 206
  (let ((death-day (extract-calendar-day death-date))
        (death-month (extract-calendar-month death-date))
        (death-year (extract-calendar-year death-date)))
Edward M. Reingold's avatar
Edward M. Reingold committed
207 208 209 210 211
    (cond
     ;; If it's Heshvan 30 it depends on the first anniversary; if
     ;; that was not Heshvan 30, use the day before Kislev 1.
     ((and (= death-month 8)
           (= death-day 30)
212 213
           (not (calendar-hebrew-long-heshvan-p (1+ death-year))))
      (1- (calendar-hebrew-to-absolute (list 9 1 year))))
Glenn Morris's avatar
Glenn Morris committed
214 215
     ;; If it's Kislev 30 it depends on the first anniversary; if that
     ;; was not Kislev 30, use the day before Teveth 1.
Edward M. Reingold's avatar
Edward M. Reingold committed
216 217
     ((and (= death-month 9)
           (= death-day 30)
218 219
           (calendar-hebrew-short-kislev-p (1+ death-year)))
      (1- (calendar-hebrew-to-absolute (list 10 1 year))))
Glenn Morris's avatar
Glenn Morris committed
220 221
     ;; If it's Adar II, use the same day in last month of year (Adar
     ;; or Adar II).
Edward M. Reingold's avatar
Edward M. Reingold committed
222
     ((= death-month 13)
223 224
      (calendar-hebrew-to-absolute
       (list (calendar-hebrew-last-month-of-year year) death-day year)))
Glenn Morris's avatar
Glenn Morris committed
225 226
     ;; If it's the 30th in Adar I and year is not a leap year (so
     ;; Adar has only 29 days), use the last day in Shevat.
Edward M. Reingold's avatar
Edward M. Reingold committed
227 228
     ((and (= death-day 30)
           (= death-month 12)
229 230
           (not (calendar-hebrew-leap-year-p year)))
      (calendar-hebrew-to-absolute (list 11 30 year)))
Edward M. Reingold's avatar
Edward M. Reingold committed
231
     ;; In all other cases, use the normal anniversary of the date of death.
232
     (t (calendar-hebrew-to-absolute
Edward M. Reingold's avatar
Edward M. Reingold committed
233 234
         (list death-month death-day year))))))

235 236 237
(define-obsolete-function-alias 'hebrew-calendar-yahrzeit
  'calendar-hebrew-yahrzeit "23.1")

238 239 240
(defun calendar-hebrew-read-date ()
  "Interactively read the arguments for a Hebrew date command.
Reads a year, month, and day."
241 242 243 244 245 246 247 248
  (let* ((today (calendar-current-date))
         (year (calendar-read
                "Hebrew calendar year (>3760): "
                (lambda (x) (> x 3760))
                (int-to-string
                 (extract-calendar-year
                  (calendar-hebrew-from-absolute
                   (calendar-absolute-from-gregorian today))))))
249
         (month-array (if (calendar-hebrew-leap-year-p year)
250 251 252 253 254 255 256 257 258 259 260 261 262 263 264
                          calendar-hebrew-month-name-array-leap-year
                        calendar-hebrew-month-name-array-common-year))
         (completion-ignore-case t)
         (month (cdr (assoc-string
                      (completing-read
                       "Hebrew calendar month name: "
                       (mapcar 'list (append month-array nil))
                       (if (= year 3761)
                           (lambda (x)
                             (let ((m (cdr
                                       (assoc-string
                                        (car x)
                                        (calendar-make-alist month-array)
                                        t))))
                               (< 0
265
                                  (calendar-hebrew-to-absolute
266
                                   (list m
267
                                         (calendar-hebrew-last-day-of-month
268 269 270 271
                                          m year)
                                         year))))))
                       t)
                      (calendar-make-alist month-array 1) t)))
272
         (last (calendar-hebrew-last-day-of-month month year))
273 274 275 276 277 278 279 280
         (first (if (and (= year 3761) (= month 10))
                    18 1))
         (day (calendar-read
               (format "Hebrew calendar day (%d-%d): "
                       first last)
               (lambda (x) (and (<= first x) (<= x last))))))
    (list (list month day year))))

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))
Edward M. Reingold's avatar
Edward M. Reingold committed
285
  (calendar-goto-date (calendar-gregorian-from-absolute
286 287 288 289 290
                       (calendar-hebrew-to-absolute date)))
  (or noecho (calendar-hebrew-print-date)))

(define-obsolete-function-alias 'calendar-goto-hebrew-date
  'calendar-hebrew-goto-date "23.1")
Edward M. Reingold's avatar
Edward M. Reingold committed
291

292 293
(defvar displayed-month)                ; from generate-calendar

294 295 296
(defun calendar-hebrew-date-is-visible-p (month day)
  "Return non-nil if Hebrew MONTH DAY is visible in the calendar window.
Returns the corresponding Gregorian date."
Glenn Morris's avatar
Glenn Morris committed
297 298
  ;; This test is only to speed things up a bit; it works fine without it.
  (if (memq displayed-month
Glenn Morris's avatar
Glenn Morris committed
299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321
            ;; What this is doing is equivalent to +1,2,3,4,5 modulo 12, ie:
            ;;  (mapcar (lambda (n) (let ((x (mod n 12)))
            ;;                        (if (zerop x) 12
            ;;                          x)))
            ;;          (number-sequence (1+ month) (+ 5 month)))
            ;; Ie it makes a list:
            ;;  2  3  4  5  6 when month = 1
            ;;  3  4  5  6  7 when month = 2
            ;; ...
            ;;  8  9 10 11 12 when month = 7
            ;;  9 10 11 12  1 when month = 8
            ;; ...
            ;; 12  1  2  3  4 when month = 11
            ;;  1  2  3  4  5 when month = 12
            ;; This implies that hebrew month N cannot occur outside
            ;; Gregorian months N:N+6 (the calendar shows
            ;; displayed-month +/- 1 at any time).
            ;; So to put it another way:
            ;;  (calendar-interval month 1 displayed-month
            ;;                    (if (> month displayed-month) 2 1))
            ;; must be >= 1 and <= 5.  This could be expanded to:
            ;;  (if (> month displayed-month) (+ 12 (- displayed-month month))
            ;;    (- displayed-month month)
Glenn Morris's avatar
Glenn Morris committed
322
            (list
Edward M. Reingold's avatar
Edward M. Reingold committed
323 324 325 326 327
             (if (< 11 month) (- month 11) (+ month 1))
             (if (< 10 month) (- month 10) (+ month 2))
             (if (<  9 month) (- month  9) (+ month 3))
             (if (<  8 month) (- month  8) (+ month 4))
             (if (<  7 month) (- month  7) (+ month 5))))
328
      (calendar-nongregorian-visible-p
329
       month day 'calendar-hebrew-to-absolute
330 331 332 333
       'calendar-hebrew-from-absolute
       ;; Hebrew new year is start of month 7.
       ;; If hmonth >= 7, choose the higher year.
       (lambda (m) (> m 6)))))
334 335 336 337 338 339 340 341 342

;;;###holiday-autoload
(defun holiday-hebrew (month day string)
  "Holiday on MONTH, DAY (Hebrew) called STRING.
If MONTH, DAY (Hebrew) is visible, the value returned is corresponding
Gregorian date in the form of the list (((month day year) STRING)).  Returns
nil if it is not visible in the current calendar window."
  (let ((gdate (calendar-hebrew-date-is-visible-p month day)))
    (if gdate (list (list gdate string)))))
Edward M. Reingold's avatar
Edward M. Reingold committed
343

344 345 346
;; h-r-h-e should be called from holidays code.
(declare-function holiday-filter-visible-calendar "holidays" (l))

347 348
(defvar displayed-year)

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 354
or ALL is non-nil."
  (when (memq displayed-month '(8 9 10 11))
355
    (let ((abs-r-h (calendar-hebrew-to-absolute
356 357 358 359 360 361 362 363 364 365 366 367 368 369
                    (list 7 1 (+ displayed-year 3761)))))
      (holiday-filter-visible-calendar
       (append
        (list
         (list (calendar-gregorian-from-absolute abs-r-h)
               (format "Rosh HaShanah %d" (+ 3761 displayed-year)))
         (list (calendar-gregorian-from-absolute (+ abs-r-h 9))
               "Yom Kippur")
         (list (calendar-gregorian-from-absolute (+ abs-r-h 14))
               "Sukkot")
         (list (calendar-gregorian-from-absolute (+ abs-r-h 21))
               "Shemini Atzeret")
         (list (calendar-gregorian-from-absolute (+ abs-r-h 22))
               "Simchat Torah"))
370
        (when (or all calendar-hebrew-all-holidays-flag)
371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400
          (list
           (list (calendar-gregorian-from-absolute
                  (calendar-dayname-on-or-before 6 (- abs-r-h 4)))
                 "Selichot (night)")
           (list (calendar-gregorian-from-absolute (1- abs-r-h))
                 "Erev Rosh HaShanah")
           (list (calendar-gregorian-from-absolute (1+ abs-r-h))
                 "Rosh HaShanah (second day)")
           (list (calendar-gregorian-from-absolute
                  (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2)))
                 "Tzom Gedaliah")
           (list (calendar-gregorian-from-absolute
                  (calendar-dayname-on-or-before 6 (+ 7 abs-r-h)))
                 "Shabbat Shuvah")
           (list (calendar-gregorian-from-absolute (+ abs-r-h 8))
                 "Erev Yom Kippur")
           (list (calendar-gregorian-from-absolute (+ abs-r-h 13))
                 "Erev Sukkot")
           (list (calendar-gregorian-from-absolute (+ abs-r-h 15))
                 "Sukkot (second day)")
           (list (calendar-gregorian-from-absolute (+ abs-r-h 16))
                 "Hol Hamoed Sukkot (first day)")
           (list (calendar-gregorian-from-absolute (+ abs-r-h 17))
                 "Hol Hamoed Sukkot (second day)")
           (list (calendar-gregorian-from-absolute (+ abs-r-h 18))
                 "Hol Hamoed Sukkot (third day)")
           (list (calendar-gregorian-from-absolute (+ abs-r-h 19))
                 "Hol Hamoed Sukkot (fourth day)")
           (list (calendar-gregorian-from-absolute (+ abs-r-h 20))
                   "Hoshanah Rabbah"))))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
401

402
;;;###holiday-autoload
403 404 405 406 407
(define-obsolete-function-alias 'holiday-rosh-hashanah-etc
  'holiday-hebrew-rosh-hashanah "23.1")

;;;###holiday-autoload
(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."
Glenn Morris's avatar
Glenn Morris committed
411
  ;; This test is only to speed things up a bit, it works fine without it.
412 413 414 415 416 417 418 419 420
  (when (memq displayed-month '(10 11 12 1 2))
    (let* ((m displayed-month)
           (y displayed-year)
           (h-y (progn
                  (increment-calendar-month m y 1)
                  (extract-calendar-year
                   (calendar-hebrew-from-absolute
                    (calendar-absolute-from-gregorian
                     (list m (calendar-last-day-of-month m y) y))))))
421
           (abs-h (calendar-hebrew-to-absolute (list 9 25 h-y)))
422 423 424 425
           (ord ["first" "second" "third" "fourth" "fifth" "sixth"
                 "seventh" "eighth"])
           han)
      (holiday-filter-visible-calendar
426
       (if (or all calendar-hebrew-all-holidays-flag)
427 428 429 430 431 432 433 434 435 436
           (append
            (list
             (list (calendar-gregorian-from-absolute (1- abs-h))
                   "Erev Hanukkah"))
            (dotimes (i 8 (nreverse han))
              (push (list
                     (calendar-gregorian-from-absolute (+ abs-h i))
                     (format "Hanukkah (%s day)" (aref ord i)))
                    han)))
         (list (list (calendar-gregorian-from-absolute abs-h) "Hanukkah")))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
437

438
;;;###holiday-autoload
439 440 441 442 443
(define-obsolete-function-alias 'holiday-hanukkah
  'holiday-hebrew-hanukkah "23.1")

;;;###holiday-autoload
(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 447
or ALL is non-nil."
  (when (< displayed-month 8)
448
    (let ((abs-p (calendar-hebrew-to-absolute
449 450 451 452 453 454 455 456
                  (list 1 15 (+ displayed-year 3760)))))
      (holiday-filter-visible-calendar
       ;; The first two are out of order when the others are added.
       (append
        (list
         (list (calendar-gregorian-from-absolute abs-p) "Passover")
         (list (calendar-gregorian-from-absolute (+ abs-p 50))
                    "Shavuot"))
457
        (when (or all calendar-hebrew-all-holidays-flag)
458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519
          (list
           (list (calendar-gregorian-from-absolute
                  (calendar-dayname-on-or-before 6 (- abs-p 43)))
                 "Shabbat Shekalim")
           (list (calendar-gregorian-from-absolute
                  (calendar-dayname-on-or-before 6 (- abs-p 30)))
                 "Shabbat Zachor")
           (list (calendar-gregorian-from-absolute
                  (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31)))
                 "Fast of Esther")
           (list (calendar-gregorian-from-absolute (- abs-p 31))
                 "Erev Purim")
           (list (calendar-gregorian-from-absolute (- abs-p 30))
                 "Purim")
           (list (calendar-gregorian-from-absolute
                  (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29)))
                 "Shushan Purim")
           (list (calendar-gregorian-from-absolute
                  (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7))
                 "Shabbat Parah")
           (list (calendar-gregorian-from-absolute
                  (calendar-dayname-on-or-before 6 (- abs-p 14)))
                 "Shabbat HaHodesh")
           (list (calendar-gregorian-from-absolute
                  (calendar-dayname-on-or-before 6 (1- abs-p)))
                 "Shabbat HaGadol")
           (list (calendar-gregorian-from-absolute (1- abs-p))
                 "Erev Passover")
           (list (calendar-gregorian-from-absolute (1+ abs-p))
                 "Passover (second day)")
           (list (calendar-gregorian-from-absolute (+ abs-p 2))
                 "Hol Hamoed Passover (first day)")
           (list (calendar-gregorian-from-absolute (+ abs-p 3))
                 "Hol Hamoed Passover (second day)")
           (list (calendar-gregorian-from-absolute (+ abs-p 4))
                 "Hol Hamoed Passover (third day)")
           (list (calendar-gregorian-from-absolute (+ abs-p 5))
                 "Hol Hamoed Passover (fourth day)")
           (list (calendar-gregorian-from-absolute (+ abs-p 6))
                 "Passover (seventh day)")
           (list (calendar-gregorian-from-absolute (+ abs-p 7))
                 "Passover (eighth day)")
           (list (calendar-gregorian-from-absolute
                  (if (zerop (% (+ abs-p 12) 7))
                      (+ abs-p 13)
                    (+ abs-p 12)))
                 "Yom HaShoah")
           (list (calendar-gregorian-from-absolute
                  (if (zerop (% abs-p 7))
                      (+ abs-p 18)
                    (if (= (% abs-p 7) 6)
                        (+ abs-p 19)
                      (+ abs-p 20))))
                 "Yom HaAtzma'ut")
           (list (calendar-gregorian-from-absolute (+ abs-p 33))
                 "Lag BaOmer")
           (list (calendar-gregorian-from-absolute (+ abs-p 43))
                 "Yom Yerushalaim")
           (list (calendar-gregorian-from-absolute (+ abs-p 49))
                 "Erev Shavuot")
           (list (calendar-gregorian-from-absolute (+ abs-p 51))
                 "Shavuot (second day)"))))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
520

521
;;;###holiday-autoload
522 523 524 525 526
(define-obsolete-function-alias 'holiday-passover-etc
  'holiday-hebrew-passover "23.1")

;;;###holiday-autoload
(defun holiday-hebrew-tisha-b-av ()
Edward M. Reingold's avatar
Edward M. Reingold committed
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
Edward M. Reingold's avatar
Edward M. Reingold committed
533 534 535 536 537 538 539 540 541 542 543 544 545
        (list (calendar-gregorian-from-absolute
               (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
              "Tzom Tammuz")
        (list (calendar-gregorian-from-absolute
               (calendar-dayname-on-or-before 6 abs-t-a))
              "Shabbat Hazon")
        (list (calendar-gregorian-from-absolute
               (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a))
              "Tisha B'Av")
        (list (calendar-gregorian-from-absolute
               (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
              "Shabbat Nahamu"))))))

546 547 548 549
;;;###holiday-autoload
(define-obsolete-function-alias 'holiday-tisha-b-av-etc
  'holiday-hebrew-tisha-b-av "23.1")

550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577
(autoload 'holiday-julian "cal-julian")

;;;###holiday-autoload
(defun holiday-hebrew-misc ()
  "Miscellaneous Hebrew holidays, if visible in calendar window.
Includes: Tal Umatar, Tzom Teveth, Tu B'Shevat, Shabbat Shirah, and
Kiddush HaHamah."
  (let ((m displayed-month)
        (y displayed-year)
        year h-year s-s)
    (append
     (holiday-julian
      11
      (progn
        (increment-calendar-month m y -1)
        (setq year (extract-calendar-year
                    (calendar-julian-from-absolute
                     (calendar-absolute-from-gregorian (list m 1 y)))))
        (if (zerop (% (1+ year) 4))
            22
          21)) "\"Tal Umatar\" (evening)")
     (holiday-hebrew
      10
      (progn
        (setq h-year (extract-calendar-year
                      (calendar-hebrew-from-absolute
                       (calendar-absolute-from-gregorian
                        (list displayed-month 28 displayed-year)))))
578
        (if (= 6 (% (calendar-hebrew-to-absolute (list 10 10 h-year))
579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596
                    7))
            11 10))
      "Tzom Teveth")
     (holiday-hebrew 11 15 "Tu B'Shevat")
     (holiday-hebrew
      11
      (progn
        (setq m displayed-month
              y displayed-year
              h-year (progn
                       (increment-calendar-month m y 1)
                       (extract-calendar-year
                        (calendar-hebrew-from-absolute
                         (calendar-absolute-from-gregorian
                          (list m (calendar-last-day-of-month m y) y)))))
              s-s
              (calendar-hebrew-from-absolute
               (if (= 6
597
                      (% (calendar-hebrew-to-absolute
598 599 600
                          (list 7 1 h-year))
                         7))
                   (calendar-dayname-on-or-before
601
                    6 (calendar-hebrew-to-absolute
602 603
                       (list 11 17 h-year)))
                 (calendar-dayname-on-or-before
604
                  6 (calendar-hebrew-to-absolute
605 606 607 608 609 610 611 612 613 614 615 616 617 618 619
                     (list 11 16 h-year))))))
        (extract-calendar-day s-s))
      "Shabbat Shirah")
     (and (progn
            (setq m displayed-month
                  y displayed-year
                  year (progn
                         (increment-calendar-month m y -1)
                         (extract-calendar-year
                          (calendar-julian-from-absolute
                           (calendar-absolute-from-gregorian (list m 1 y))))))
            (= 21 (% year 28)))
          (holiday-julian 3 26 "Kiddush HaHamah")))))


620
(autoload 'diary-list-entries-1 "diary-lib")
621

622
;;;###diary-autoload
623
(defun diary-hebrew-list-entries ()
Edward M. Reingold's avatar
Edward M. Reingold committed
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 627
\(normally an `H').  The same diary date forms govern the style
of the Hebrew calendar entries, except that the Hebrew month
628
names cannot be abbreviated.  The Hebrew months are numbered
629 630 631 632 633
from 1 to 13 with Nisan being 1, 12 being Adar I and 13 being
Adar II; you must use `Adar I' if you want Adar of a common
Hebrew year.  If a Hebrew date diary entry begins with
`diary-nonmarking-symbol', the entry will appear in the diary
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 639 640
;;;###diary-autoload
(define-obsolete-function-alias 'list-hebrew-diary-entries
  'diary-hebrew-list-entries "23.1")
Edward M. Reingold's avatar
Edward M. Reingold committed
641

642 643
(autoload 'calendar-mark-complex "diary-lib")

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 648 649 650
A value of 0 in any position is a wildcard.  Optional argument COLOR is
passed to `mark-visible-calendar-date' as MARK."
  ;; FIXME not the same as the Bahai and Islamic cases, so can't use
  ;; calendar-mark-1.
651 652
  (save-excursion
    (set-buffer calendar-buffer)
653 654
    (if (and (not (zerop month)) (not (zerop day)))
        (if (not (zerop year))
655 656
            ;; Fully specified Hebrew date.
            (let ((date (calendar-gregorian-from-absolute
657
                         (calendar-hebrew-to-absolute
658 659
                          (list month day year)))))
              (if (calendar-date-is-visible-p date)
660
                  (mark-visible-calendar-date date color)))
661 662 663
          ;; Month and day in any year.
          (let ((gdate (calendar-hebrew-date-is-visible-p month day)))
            (if gdate (mark-visible-calendar-date gdate color))))
664 665
      (calendar-mark-complex month day year
                             'calendar-hebrew-from-absolute color))))
666

667 668 669 670
;;;###diary-autoload
(define-obsolete-function-alias 'mark-hebrew-calendar-date-pattern
  'calendar-hebrew-mark-date-pattern "23.1")

671
(autoload 'diary-mark-entries-1 "diary-lib")
672

673
;;;###diary-autoload
674
(defun diary-hebrew-mark-entries ()
Edward M. Reingold's avatar
Edward M. Reingold committed
675
  "Mark days in the calendar window that have Hebrew date diary entries.
676 677
Marks each entry in `diary-file' (or included files) visible in the calendar
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))
Edward M. Reingold's avatar
Edward M. Reingold committed
682

683 684 685
;;;###diary-autoload
(define-obsolete-function-alias 'mark-hebrew-diary-entries
  'diary-hebrew-mark-entries "23.1")
Glenn Morris's avatar
Glenn Morris committed
686 687 688

(autoload 'diary-insert-entry-1 "diary-lib")

689
;;;###cal-autoload
690 691
(defun diary-hebrew-insert-entry (arg)
  "Insert a diary entry for the Hebrew date at point.
Glenn Morris's avatar
Glenn Morris committed
692
Prefix argument ARG makes the entry nonmarking."
Edward M. Reingold's avatar
Edward M. Reingold committed
693
  (interactive "P")
Glenn Morris's avatar
Glenn Morris committed
694
  (diary-insert-entry-1 nil arg calendar-hebrew-month-name-array-leap-year
695
                        diary-hebrew-entry-symbol
Glenn Morris's avatar
Glenn Morris committed
696
                        'calendar-hebrew-from-absolute))
Edward M. Reingold's avatar
Edward M. Reingold committed
697

698 699 700 701
;;;###diary-autoload
(define-obsolete-function-alias 'insert-hebrew-diary-entry
  'diary-hebrew-insert-entry "23.1")

702
;;;###cal-autoload
703
(defun diary-hebrew-insert-monthly-entry (arg)
Edward M. Reingold's avatar
Edward M. Reingold committed
704 705
  "Insert a monthly diary entry.
For the day of the Hebrew month corresponding to the date indicated by point.
Glenn Morris's avatar
Glenn Morris committed
706
Prefix argument ARG makes the entry nonmarking."
Edward M. Reingold's avatar
Edward M. Reingold committed
707
  (interactive "P")
Glenn Morris's avatar
Glenn Morris committed
708
  (diary-insert-entry-1 'monthly arg calendar-hebrew-month-name-array-leap-year
709
                        diary-hebrew-entry-symbol
Glenn Morris's avatar
Glenn Morris committed
710
                        'calendar-hebrew-from-absolute))
711 712 713
;;;###diary-autoload
(define-obsolete-function-alias 'insert-monthly-hebrew-diary-entry
  'diary-hebrew-insert-monthly-entry "23.1")
Edward M. Reingold's avatar
Edward M. Reingold committed
714

715
;;;###cal-autoload
716
(defun diary-hebrew-insert-yearly-entry (arg)
Edward M. Reingold's avatar
Edward M. Reingold committed
717 718
  "Insert an annual diary entry.
For the day of the Hebrew year corresponding to the date indicated by point.
Glenn Morris's avatar
Glenn Morris committed
719
Prefix argument ARG makes the entry nonmarking."
Edward M. Reingold's avatar
Edward M. Reingold committed
720
  (interactive "P")
Glenn Morris's avatar
Glenn Morris committed
721
  (diary-insert-entry-1 'yearly arg calendar-hebrew-month-name-array-leap-year
722
                        diary-hebrew-entry-symbol
Glenn Morris's avatar
Glenn Morris committed
723
                        'calendar-hebrew-from-absolute))
724 725 726
;;;###diary-autoload
(define-obsolete-function-alias 'insert-yearly-hebrew-diary-entry
  'diary-hebrew-insert-yearly-entry "23.1")
Edward M. Reingold's avatar
Edward M. Reingold committed
727 728

;;;###autoload
729
(defun calender-hebrew-list-yahrzeits (death-date start-year end-year)
Edward M. Reingold's avatar
Edward M. Reingold committed
730 731 732 733 734 735 736 737 738 739
  "List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
When called interactively from the calendar window, the date of death is taken
from the cursor position."
  (interactive
   (let* ((death-date
           (if (equal (current-buffer) (get-buffer calendar-buffer))
               (calendar-cursor-to-date)
             (let* ((today (calendar-current-date))
                    (year (calendar-read
                           "Year of death (>0): "
Glenn Morris's avatar
Glenn Morris committed
740
                           (lambda (x) (> x 0))
Edward M. Reingold's avatar
Edward M. Reingold committed
741 742 743
                           (int-to-string (extract-calendar-year today))))
                    (month-array calendar-month-name-array)
                    (completion-ignore-case t)
744
                    (month (cdr (assoc-string
745 746 747 748
                                 (completing-read
                                  "Month of death (name): "
                                  (mapcar 'list (append month-array nil))
                                  nil t)
749
                                 (calendar-make-alist month-array 1) t)))
Edward M. Reingold's avatar
Edward M. Reingold committed
750 751 752
                    (last (calendar-last-day-of-month month year))
                    (day (calendar-read
                          (format "Day of death (1-%d): " last)
Glenn Morris's avatar
Glenn Morris committed
753
                          (lambda (x) (and (< 0 x) (<= x last))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
754 755 756 757 758
               (list month day year))))
          (death-year (extract-calendar-year death-date))
          (start-year (calendar-read
                       (format "Starting year of Yahrzeit table (>%d): "
                               death-year)
Glenn Morris's avatar
Glenn Morris committed
759
                       (lambda (x) (> x death-year))
Edward M. Reingold's avatar
Edward M. Reingold committed
760 761 762 763
                       (int-to-string (1+ death-year))))
          (end-year (calendar-read
                     (format "Ending year of Yahrzeit table (>=%d): "
                             start-year)
Glenn Morris's avatar
Glenn Morris committed
764 765
                     (lambda (x) (>= x start-year)))))
     (list death-date start-year end-year)))
Glenn Morris's avatar
Glenn Morris committed
766
  (message "Computing Yahrzeits...")
767
  (let* ((h-date (calendar-hebrew-from-absolute
Edward M. Reingold's avatar
Edward M. Reingold committed
768 769 770
                  (calendar-absolute-from-gregorian death-date)))
         (h-month (extract-calendar-month h-date))
         (h-day (extract-calendar-day h-date))
771 772
         (h-year (extract-calendar-year h-date))
         (i (1- start-year)))
773 774 775 776 777
    (calendar-in-read-only-buffer cal-hebrew-yahrzeit-buffer
      (calendar-set-mode-line
       (format "Yahrzeit dates for %s = %s"
               (calendar-date-string death-date)
               (let ((calendar-month-name-array
778
                      (if (calendar-hebrew-leap-year-p h-year)
779 780 781
                          calendar-hebrew-month-name-array-leap-year
                        calendar-hebrew-month-name-array-common-year)))
                 (calendar-date-string h-date nil t))))
782
      (while (<= (setq i (1+ i)) end-year)
783 784 785
        (insert
         (calendar-date-string
          (calendar-gregorian-from-absolute
786
           (calendar-hebrew-yahrzeit
787 788 789
            h-date
            (extract-calendar-year
             (calendar-hebrew-from-absolute
790 791
              (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n"))))
  (message "Computing Yahrzeits...done"))
Edward M. Reingold's avatar
Edward M. Reingold committed
792

793 794 795 796
;;;###autoload
(define-obsolete-function-alias 'list-yahrzeit-dates
  'calender-hebrew-list-yahrzeits "23.1")

797 798
(defvar date)

799
;; To be called from diary-list-sexp-entries, where DATE is bound.
800
;;;###diary-autoload
Edward M. Reingold's avatar
Edward M. Reingold committed
801 802 803 804
(defun diary-hebrew-date ()
  "Hebrew calendar equivalent of date diary entry."
  (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))

805
;;;###diary-autoload
806
(defun diary-hebrew-omer (&optional mark)
Edward M. Reingold's avatar
Edward M. Reingold committed
807
  "Omer count diary entry.
808 809
Entry applies if date is within 50 days after Passover.

810
An optional parameter MARK specifies a face or single-character string to
811
use when highlighting the day in the calendar."
Edward M. Reingold's avatar
Edward M. Reingold committed
812
  (let* ((passover
813
          (calendar-hebrew-to-absolute
Edward M. Reingold's avatar
Edward M. Reingold committed
814 815 816 817 818
           (list 1 15 (+ (extract-calendar-year date) 3760))))
         (omer (- (calendar-absolute-from-gregorian date) passover))
         (week (/ omer 7))
         (day (% omer 7)))
    (if (and (> omer 0) (< omer 50))
819
        (cons mark
Glenn Morris's avatar
Glenn Morris committed
820 821 822 823 824 825 826 827 828 829 830
              (format "Day %d%s of the omer (until sunset)"
                      omer
                      (if (zerop week)
                          ""
                        (format ", that is, %d week%s%s"
                                week
                                (if (= week 1) "" "s")
                                (if (zerop day)
                                    ""
                                  (format " and %d day%s"
                                          day (if (= day 1) "" "s"))))))))))
831 832
;;;###diary-autoload
(define-obsolete-function-alias 'diary-omer 'diary-hebrew-omer "23.1")
Edward M. Reingold's avatar
Edward M. Reingold committed
833

834 835
(defvar entry)

Glenn Morris's avatar
Glenn Morris committed
836 837
(autoload 'diary-make-date "diary-lib")

838
;;;###diary-autoload
839
(defun diary-hebrew-yahrzeit (death-month death-day death-year &optional mark)
Glenn Morris's avatar
Glenn Morris committed
840
  "Yahrzeit diary entry--entry applies if date is Yahrzeit or the day before.
Glenn Morris's avatar
Glenn Morris committed
841 842 843 844 845 846 847
Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary
entry is assumed to be the name of the person.  Although the date
of death is specified by the civil calendar, the proper Hebrew
calendar Yahrzeit is determined.

The order of the input parameters changes according to `calendar-date-style'
\(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."
Edward M. Reingold's avatar
Edward M. Reingold committed
851 852
  (let* ((h-date (calendar-hebrew-from-absolute
                  (calendar-absolute-from-gregorian
Glenn Morris's avatar
Glenn Morris committed
853
                   (diary-make-date death-month death-day death-year))))
Edward M. Reingold's avatar
Edward M. Reingold committed
854 855 856 857 858 859
         (h-month (extract-calendar-month h-date))
         (h-day (extract-calendar-day h-date))
         (h-year (extract-calendar-year h-date))
         (d (calendar-absolute-from-gregorian date))
         (yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
         (diff (- yr h-year))
860
         (y (calendar-hebrew-yahrzeit h-date yr)))
Edward M. Reingold's avatar
Edward M. Reingold committed
861
    (if (and (> diff 0) (or (= y d) (= y (1+ d))))
862
        (cons mark
Glenn Morris's avatar
Glenn Morris committed
863 864 865 866 867 868 869 870
              (format "Yahrzeit of %s%s: %d%s anniversary"
                      entry
                      (if (= y d) "" " (evening)")
                      diff
                      (cond ((= (% diff 10) 1) "st")
                            ((= (% diff 10) 2) "nd")
                            ((= (% diff 10) 3) "rd")
                            (t "th")))))))
871 872
;;;###diary-autoload
(define-obsolete-function-alias 'diary-yahrzeit 'diary-hebrew-yahrzeit "23.1")
Edward M. Reingold's avatar
Edward M. Reingold committed
873

874
;;;###diary-autoload
875
(defun diary-hebrew-rosh-hodesh (&optional mark)
Edward M. Reingold's avatar
Edward M. Reingold committed
876
  "Rosh Hodesh diary entry.
877 878
Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.

879
An optional parameter MARK specifies a face or single-character string to
880
use when highlighting the day in the calendar."
Edward M. Reingold's avatar
Edward M. Reingold committed
881 882 883 884 885
  (let* ((d (calendar-absolute-from-gregorian date))
         (h-date (calendar-hebrew-from-absolute d))
         (h-month (extract-calendar-month h-date))
         (h-day (extract-calendar-day h-date))
         (h-year (extract-calendar-year h-date))
886 887
         (leap-year (calendar-hebrew-leap-year-p h-year))
         (last-day (calendar-hebrew-last-day-of-month h-month h-year))
Edward M. Reingold's avatar
Edward M. Reingold committed
888 889 890 891 892 893 894 895
         (h-month-names
          (if leap-year
              calendar-hebrew-month-name-array-leap-year
            calendar-hebrew-month-name-array-common-year))
         (this-month (aref h-month-names (1- h-month)))
         (h-yesterday (extract-calendar-day
                       (calendar-hebrew-from-absolute (1- d)))))
    (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
896
        (cons mark
Glenn Morris's avatar
Glenn Morris committed
897 898 899 900 901 902 903 904 905 906 907 908 909
              (format
               "Rosh Hodesh %s"
               (if (= h-day 30)
                   (format
                    "%s (first day)"
                    ;; Next month must be in the same year since this
                    ;; month can't be the last month of the year since
                    ;; it has 30 days
                    (aref h-month-names h-month))
                 (if (= h-yesterday 30)
                     (format "%s (second day)" this-month)
                   this-month))))
      (if (= (% d 7) 6)        ; Saturday--check for Shabbat Mevarchim
910
          (cons mark
Glenn Morris's avatar
Glenn Morris committed
911 912 913 914
                (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
                       (format "Mevarchim Rosh Hodesh %s (%s)"
                               (aref h-month-names
                                     (if (= h-month
915
                                            (calendar-hebrew-last-month-of-year
Glenn Morris's avatar
Glenn Morris committed
916 917 918 919 920 921 922 923 924 925 926
                                             h-year))
                                         0 h-month))
                               (aref calendar-day-name-array (- 29 h-day))))
                      ((and (< h-day