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

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1995, 1997, 2001-2019 Free Software Foundation, Inc.
Edward M. Reingold's avatar
Edward M. Reingold committed
4

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

;; This file is part of GNU Emacs.

14
;; GNU Emacs is free software: you can redistribute it and/or modify
Edward M. Reingold's avatar
Edward M. Reingold committed
15
;; it under the terms of the GNU General Public License as published by
16 17
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Edward M. Reingold's avatar
Edward M. Reingold committed
18 19 20 21 22 23 24

;; 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
25
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Edward M. Reingold's avatar
Edward M. Reingold committed
26 27 28

;;; Commentary:

29
;; See calendar.el.
30

Edward M. Reingold's avatar
Edward M. Reingold committed
31 32
;;; Code:

33
(require 'calendar)
Edward M. Reingold's avatar
Edward M. Reingold committed
34

35 36 37 38 39 40 41 42 43
(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")

;; End of user options.

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

48
(defun calendar-hebrew-last-month-of-year (year)
Edward M. Reingold's avatar
Edward M. Reingold committed
49
  "The last month of the Hebrew calendar YEAR."
50
  (if (calendar-hebrew-leap-year-p year)
Edward M. Reingold's avatar
Edward M. Reingold committed
51 52 53
      13
    12))

54
(defun calendar-hebrew-elapsed-days (year)
55 56
  "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
57
  (let* ((months-elapsed
Glenn Morris's avatar
Glenn Morris committed
58 59 60
          (+ (* 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
61 62 63 64 65
         (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
66
         (parts                         ; conjunction parts
Edward M. Reingold's avatar
Edward M. Reingold committed
67
          (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
Glenn Morris's avatar
Glenn Morris committed
68
         (day                           ; conjunction day
Edward M. Reingold's avatar
Edward M. Reingold committed
69 70
          (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
         (alternative-day
Glenn Morris's avatar
Glenn Morris committed
71
          (if (or (>= parts 19440) ; if the new moon is at or after midday
Glenn Morris's avatar
Glenn Morris committed
72
                  (and (= (% day 7) 2)  ; ...or is on a Tuesday...
Glenn Morris's avatar
Glenn Morris committed
73
                       (>= parts 9924) ; at 9 hours, 204 parts or later...
Glenn Morris's avatar
Glenn Morris committed
74
                       ;; of a common year...
75
                       (not (calendar-hebrew-leap-year-p year)))
Glenn Morris's avatar
Glenn Morris committed
76
                  (and (= (% day 7) 1)  ; ...or is on a Monday...
Glenn Morris's avatar
Glenn Morris committed
77
                       (>= parts 16789) ; at 15 hours, 589 parts or later...
Glenn Morris's avatar
Glenn Morris committed
78
                       ;; at the end of a leap year.
79
                       (calendar-hebrew-leap-year-p (1- year))))
Glenn Morris's avatar
Glenn Morris committed
80
              ;; Then postpone Rosh HaShanah one day.
Edward M. Reingold's avatar
Edward M. Reingold committed
81
              (1+ day)
Glenn Morris's avatar
Glenn Morris committed
82
            ;; Else:
Edward M. Reingold's avatar
Edward M. Reingold committed
83
            day)))
Glenn Morris's avatar
Glenn Morris committed
84 85
    ;; 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
86
        ;; Then postpone it one (more) day and return.
Edward M. Reingold's avatar
Edward M. Reingold committed
87
        (1+ alternative-day)
Glenn Morris's avatar
Glenn Morris committed
88
      ;; Else return.
Edward M. Reingold's avatar
Edward M. Reingold committed
89 90
      alternative-day)))

91
(defun calendar-hebrew-days-in-year (year)
Edward M. Reingold's avatar
Edward M. Reingold committed
92
  "Number of days in Hebrew YEAR."
93 94
  (- (calendar-hebrew-elapsed-days (1+ year))
     (calendar-hebrew-elapsed-days year)))
Edward M. Reingold's avatar
Edward M. Reingold committed
95

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

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

104
(defun calendar-hebrew-last-day-of-month (month year)
105 106
  "The last day of MONTH in YEAR."
  (if (or (memq month (list 2 4 6 10 13))
107 108 109
          (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)))
110 111 112
      29
    30))

113
(defun calendar-hebrew-to-absolute (date)
Edward M. Reingold's avatar
Edward M. Reingold committed
114 115 116
  "Absolute date of Hebrew DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
117 118 119
  (let ((month (calendar-extract-month date))
        (day (calendar-extract-day date))
        (year (calendar-extract-year date)))
Glenn Morris's avatar
Glenn Morris committed
120 121 122
    (+ 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
123
           (+ (calendar-sum
124 125
               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
126 127
              (calendar-sum
               m 1 (< m month)
128
               (calendar-hebrew-last-day-of-month m year)))
Glenn Morris's avatar
Glenn Morris committed
129
         ;; Else add days in prior months this year.
Edward M. Reingold's avatar
Edward M. Reingold committed
130 131
         (calendar-sum
          m 7 (< m month)
132 133
          (calendar-hebrew-last-day-of-month m year)))
       (calendar-hebrew-elapsed-days year) ; days in prior years
Glenn Morris's avatar
Glenn Morris committed
134
       -1373429)))               ; days elapsed before absolute date 1
Edward M. Reingold's avatar
Edward M. Reingold committed
135

136 137 138 139 140
(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))
141
         (year (+ 3760 (calendar-extract-year greg-date)))
142
         (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
143
                      (1- (calendar-extract-month greg-date))))
144
         (length (progn
145
                   (while (>= date (calendar-hebrew-to-absolute
146 147
                                    (list 7 1 (1+ year))))
                     (setq year (1+ year)))
148
                   (calendar-hebrew-last-month-of-year year)))
149
         day)
150
    (while (> date
151
              (calendar-hebrew-to-absolute
152
               (list month
153
                     (calendar-hebrew-last-day-of-month month year)
154 155
                     year)))
      (setq month (1+ (% month length))))
156
    (setq day (1+
157
               (- date (calendar-hebrew-to-absolute (list month 1 year)))))
158 159
    (list month day year)))

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

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

170
;;;###cal-autoload
Edward M. Reingold's avatar
Edward M. Reingold committed
171 172 173 174 175 176 177 178
(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
179
          (if (calendar-hebrew-leap-year-p (calendar-extract-year hebrew-date))
Edward M. Reingold's avatar
Edward M. Reingold committed
180 181 182 183
              calendar-hebrew-month-name-array-leap-year
            calendar-hebrew-month-name-array-common-year)))
    (calendar-date-string hebrew-date nil t)))

184
;;;###cal-autoload
185
(defun calendar-hebrew-print-date ()
Edward M. Reingold's avatar
Edward M. Reingold committed
186 187 188 189 190
  "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))))

191
(defun calendar-hebrew-yahrzeit (death-date year)
Edward M. Reingold's avatar
Edward M. Reingold committed
192
  "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
193 194 195
  (let ((death-day (calendar-extract-day death-date))
        (death-month (calendar-extract-month death-date))
        (death-year (calendar-extract-year death-date)))
Edward M. Reingold's avatar
Edward M. Reingold committed
196 197 198 199 200
    (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)
201 202
           (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
203 204
     ;; 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
205 206
     ((and (= death-month 9)
           (= death-day 30)
207 208
           (calendar-hebrew-short-kislev-p (1+ death-year)))
      (1- (calendar-hebrew-to-absolute (list 10 1 year))))
Glenn Morris's avatar
Glenn Morris committed
209 210
     ;; 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
211
     ((= death-month 13)
212 213
      (calendar-hebrew-to-absolute
       (list (calendar-hebrew-last-month-of-year year) death-day year)))
Glenn Morris's avatar
Glenn Morris committed
214 215
     ;; 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
216 217
     ((and (= death-day 30)
           (= death-month 12)
218 219
           (not (calendar-hebrew-leap-year-p year)))
      (calendar-hebrew-to-absolute (list 11 30 year)))
Edward M. Reingold's avatar
Edward M. Reingold committed
220
     ;; In all other cases, use the normal anniversary of the date of death.
221
     (t (calendar-hebrew-to-absolute
Edward M. Reingold's avatar
Edward M. Reingold committed
222 223
         (list death-month death-day year))))))

224 225 226
(defun calendar-hebrew-read-date ()
  "Interactively read the arguments for a Hebrew date command.
Reads a year, month, and day."
227 228 229 230
  (let* ((today (calendar-current-date))
         (year (calendar-read
                "Hebrew calendar year (>3760): "
                (lambda (x) (> x 3760))
231
                (number-to-string
232
                 (calendar-extract-year
233 234
                  (calendar-hebrew-from-absolute
                   (calendar-absolute-from-gregorian today))))))
235
         (month-array (if (calendar-hebrew-leap-year-p year)
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
                          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
251
                                  (calendar-hebrew-to-absolute
252
                                   (list m
253
                                         (calendar-hebrew-last-day-of-month
254 255 256 257
                                          m year)
                                         year))))))
                       t)
                      (calendar-make-alist month-array 1) t)))
258
         (last (calendar-hebrew-last-day-of-month month year))
259 260 261 262 263 264 265 266
         (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))))

267
;;;###cal-autoload
268
(defun calendar-hebrew-goto-date (date &optional noecho)
269
  "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is non-nil."
270
  (interactive (calendar-hebrew-read-date))
Edward M. Reingold's avatar
Edward M. Reingold committed
271
  (calendar-goto-date (calendar-gregorian-from-absolute
272 273 274
                       (calendar-hebrew-to-absolute date)))
  (or noecho (calendar-hebrew-print-date)))

275
(defvar displayed-month)                ; from calendar-generate
276

277 278 279
(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
280 281
  ;; 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
282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304
            ;; 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
305
            (list
Edward M. Reingold's avatar
Edward M. Reingold committed
306 307 308 309 310
             (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))))
311
      (calendar-nongregorian-visible-p
312
       month day 'calendar-hebrew-to-absolute
313 314 315 316
       'calendar-hebrew-from-absolute
       ;; Hebrew new year is start of month 7.
       ;; If hmonth >= 7, choose the higher year.
       (lambda (m) (> m 6)))))
317 318 319 320 321 322 323 324 325

;;;###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
326

327 328 329
;; h-r-h-e should be called from holidays code.
(declare-function holiday-filter-visible-calendar "holidays" (l))

330 331
(defvar displayed-year)

332
;;;###holiday-autoload
333
(defun holiday-hebrew-rosh-hashanah (&optional all)
334
  "List of dates related to Rosh Hashanah, as visible in calendar window.
335
Shows only the major holidays, unless `calendar-hebrew-all-holidays-flag'
336 337
or ALL is non-nil."
  (when (memq displayed-month '(8 9 10 11))
338
    (let ((abs-r-h (calendar-hebrew-to-absolute
339 340 341 342 343 344 345 346 347 348 349 350 351 352
                    (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"))
353
        (when (or all calendar-hebrew-all-holidays-flag)
354 355 356 357 358 359 360 361 362
          (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
363
                  (+ abs-r-h (if (= (% abs-r-h 7) 4) 3 2)))
364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
                 "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
384

385 386
;;;###holiday-autoload
(defun holiday-hebrew-hanukkah (&optional all)
387
  "List of dates related to Hanukkah, as visible in calendar window.
388
Shows only Hanukkah, unless `calendar-hebrew-all-holidays-flag' or ALL
389
is non-nil."
Glenn Morris's avatar
Glenn Morris committed
390
  ;; This test is only to speed things up a bit, it works fine without it.
391 392 393 394
  (when (memq displayed-month '(10 11 12 1 2))
    (let* ((m displayed-month)
           (y displayed-year)
           (h-y (progn
395 396
                  (calendar-increment-month m y 1)
                  (calendar-extract-year
397 398 399
                   (calendar-hebrew-from-absolute
                    (calendar-absolute-from-gregorian
                     (list m (calendar-last-day-of-month m y) y))))))
400
           (abs-h (calendar-hebrew-to-absolute (list 9 25 h-y)))
401 402 403 404
           (ord ["first" "second" "third" "fourth" "fifth" "sixth"
                 "seventh" "eighth"])
           han)
      (holiday-filter-visible-calendar
405
       (if (or all calendar-hebrew-all-holidays-flag)
406 407 408 409 410 411 412 413 414 415
           (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
416

417 418
;;;###holiday-autoload
(defun holiday-hebrew-passover (&optional all)
419
  "List of dates related to Passover, as visible in calendar window.
420
Shows only the major holidays, unless `calendar-hebrew-all-holidays-flag'
421 422
or ALL is non-nil."
  (when (< displayed-month 8)
423
    (let ((abs-p (calendar-hebrew-to-absolute
424 425 426 427 428 429 430 431
                  (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"))
432
        (when (or all calendar-hebrew-all-holidays-flag)
433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 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
          (let ((wday (% abs-p 7)))
            (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
                    (- abs-p (if (= wday 2) 33 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
                    (- abs-p (if (zerop wday) 28 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
                    (+ abs-p (if (zerop (% (+ abs-p 12) 7))
                                 13
                               12)))
                   "Yom HaShoah")
             (list (calendar-gregorian-from-absolute
                    (+ abs-p
                       ;; If falls on Sat or Fri, moves to preceding Thurs.
                       ;; If falls on Mon, moves to Tues (since 2004).
                       (cond ((zerop wday) 18) ; Sat
                             ((= wday 6) 19)   ; Fri
                             ((= wday 2) 21)   ; Mon
                             (t 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
498

499 500
;;;###holiday-autoload
(defun holiday-hebrew-tisha-b-av ()
Edward M. Reingold's avatar
Edward M. Reingold committed
501
  "List of dates around Tisha B'Av, as visible in calendar window."
502
  (when (memq displayed-month '(5 6 7 8 9))
503 504 505
    (let* ((abs-t-a (calendar-hebrew-to-absolute
                     (list 5 9 (+ displayed-year 3760))))
           (wday (% abs-t-a 7)))
506
      (holiday-filter-visible-calendar
507
       (list
Edward M. Reingold's avatar
Edward M. Reingold committed
508
        (list (calendar-gregorian-from-absolute
509
               (- abs-t-a (if (= wday 6) 20 21)))
Edward M. Reingold's avatar
Edward M. Reingold committed
510 511 512 513 514
              "Tzom Tammuz")
        (list (calendar-gregorian-from-absolute
               (calendar-dayname-on-or-before 6 abs-t-a))
              "Shabbat Hazon")
        (list (calendar-gregorian-from-absolute
515
               (if (= wday 6) (1+ abs-t-a) abs-t-a))
Edward M. Reingold's avatar
Edward M. Reingold committed
516 517 518 519 520
              "Tisha B'Av")
        (list (calendar-gregorian-from-absolute
               (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
              "Shabbat Nahamu"))))))

521 522 523 524 525 526 527 528 529
(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)
530
        year h-year)
531 532 533 534
    (append
     (holiday-julian
      11
      (progn
535 536
        (calendar-increment-month m y -1)
        (setq year (calendar-extract-year
537 538 539 540 541 542 543 544
                    (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
545
        (setq h-year (calendar-extract-year
546 547 548
                      (calendar-hebrew-from-absolute
                       (calendar-absolute-from-gregorian
                        (list displayed-month 28 displayed-year)))))
549
        (if (= 6 (% (calendar-hebrew-to-absolute (list 10 10 h-year))
550 551 552 553 554 555 556 557 558 559
                    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
560 561
                       (calendar-increment-month m y 1)
                       (calendar-extract-year
562 563
                        (calendar-hebrew-from-absolute
                         (calendar-absolute-from-gregorian
564 565 566 567 568 569 570 571 572 573 574
                          (list m (calendar-last-day-of-month m y) y))))))
        (calendar-extract-day
         (calendar-hebrew-from-absolute
          (calendar-dayname-on-or-before
           6 (calendar-hebrew-to-absolute
              (list 11
                    (if (= 6
                           (% (calendar-hebrew-to-absolute
                               (list 7 1 h-year))
                              7))
                        17 16) h-year))))))
575 576 577 578 579
      "Shabbat Shirah")
     (and (progn
            (setq m displayed-month
                  y displayed-year
                  year (progn
580 581
                         (calendar-increment-month m y -1)
                         (calendar-extract-year
582 583 584 585 586 587
                          (calendar-julian-from-absolute
                           (calendar-absolute-from-gregorian (list m 1 y))))))
            (= 21 (% year 28)))
          (holiday-julian 3 26 "Kiddush HaHamah")))))


588
(autoload 'diary-list-entries-1 "diary-lib")
589

590
;;;###diary-autoload
591
(defun diary-hebrew-list-entries ()
Edward M. Reingold's avatar
Edward M. Reingold committed
592
  "Add any Hebrew date entries from the diary file to `diary-entries-list'.
593
Hebrew date diary entries must be prefaced by `diary-hebrew-entry-symbol'
594 595
\(normally an `H').  The same diary date forms govern the style
of the Hebrew calendar entries, except that the Hebrew month
596
names cannot be abbreviated.  The Hebrew months are numbered
597
from 1 to 13 with Nisan being 1, 12 being Adar I and 13 being
Glenn Morris's avatar
Glenn Morris committed
598
Adar II; you must use \"Adar I\" if you want Adar of a common
599 600 601
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
602
is provided for use with `diary-nongregorian-listing-hook'."
603
  (diary-list-entries-1 calendar-hebrew-month-name-array-leap-year
604
                        diary-hebrew-entry-symbol
605
                        'calendar-hebrew-from-absolute))
Edward M. Reingold's avatar
Edward M. Reingold committed
606

607 608
(autoload 'calendar-mark-complex "diary-lib")

609
;;;###diary-autoload
610
(defun calendar-hebrew-mark-date-pattern (month day year &optional color)
611
  "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
612
A value of 0 in any position is a wildcard.  Optional argument COLOR is
613
passed to `calendar-mark-visible-date' as MARK."
614
  ;; FIXME not the same as the Bahá’í and Islamic cases, so can't use
615
  ;; calendar-mark-1.
616
  (with-current-buffer calendar-buffer
617 618
    (if (and (not (zerop month)) (not (zerop day)))
        (if (not (zerop year))
619 620
            ;; Fully specified Hebrew date.
            (let ((date (calendar-gregorian-from-absolute
621
                         (calendar-hebrew-to-absolute
622 623
                          (list month day year)))))
              (if (calendar-date-is-visible-p date)
624
                  (calendar-mark-visible-date date color)))
625 626
          ;; Month and day in any year.
          (let ((gdate (calendar-hebrew-date-is-visible-p month day)))
627
            (if gdate (calendar-mark-visible-date gdate color))))
628 629
      (calendar-mark-complex month day year
                             'calendar-hebrew-from-absolute color))))
630

631
(autoload 'diary-mark-entries-1 "diary-lib")
632

633
;;;###diary-autoload
634
(defun diary-hebrew-mark-entries ()
Edward M. Reingold's avatar
Edward M. Reingold committed
635
  "Mark days in the calendar window that have Hebrew date diary entries.
636 637
Marks each entry in `diary-file' (or included files) visible in the calendar
window.  See `list-hebrew-diary-entries' for more information."
638
  (diary-mark-entries-1 'calendar-hebrew-mark-date-pattern
639
                        calendar-hebrew-month-name-array-leap-year
640
                        diary-hebrew-entry-symbol
641
                        'calendar-hebrew-from-absolute))
Edward M. Reingold's avatar
Edward M. Reingold committed
642

Glenn Morris's avatar
Glenn Morris committed
643 644
(autoload 'diary-insert-entry-1 "diary-lib")

645
;;;###cal-autoload
646 647
(defun diary-hebrew-insert-entry (arg)
  "Insert a diary entry for the Hebrew date at point.
Glenn Morris's avatar
Glenn Morris committed
648
Prefix argument ARG makes the entry nonmarking."
Edward M. Reingold's avatar
Edward M. Reingold committed
649
  (interactive "P")
Glenn Morris's avatar
Glenn Morris committed
650
  (diary-insert-entry-1 nil arg calendar-hebrew-month-name-array-leap-year
651
                        diary-hebrew-entry-symbol
Glenn Morris's avatar
Glenn Morris committed
652
                        'calendar-hebrew-from-absolute))
Edward M. Reingold's avatar
Edward M. Reingold committed
653

654
;;;###cal-autoload
655
(defun diary-hebrew-insert-monthly-entry (arg)
Edward M. Reingold's avatar
Edward M. Reingold committed
656 657
  "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
658
Prefix argument ARG makes the entry nonmarking."
Edward M. Reingold's avatar
Edward M. Reingold committed
659
  (interactive "P")
Glenn Morris's avatar
Glenn Morris committed
660
  (diary-insert-entry-1 'monthly arg calendar-hebrew-month-name-array-leap-year
661
                        diary-hebrew-entry-symbol
Glenn Morris's avatar
Glenn Morris committed
662
                        'calendar-hebrew-from-absolute))
Edward M. Reingold's avatar
Edward M. Reingold committed
663

664
;;;###cal-autoload
665
(defun diary-hebrew-insert-yearly-entry (arg)
Edward M. Reingold's avatar
Edward M. Reingold committed
666 667
  "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
668
Prefix argument ARG makes the entry nonmarking."
Edward M. Reingold's avatar
Edward M. Reingold committed
669
  (interactive "P")
Glenn Morris's avatar
Glenn Morris committed
670
  (diary-insert-entry-1 'yearly arg calendar-hebrew-month-name-array-leap-year
671
                        diary-hebrew-entry-symbol
Glenn Morris's avatar
Glenn Morris committed
672
                        'calendar-hebrew-from-absolute))
Edward M. Reingold's avatar
Edward M. Reingold committed
673 674

;;;###autoload
675
(defun calendar-hebrew-list-yahrzeits (death-date start-year end-year)
Edward M. Reingold's avatar
Edward M. Reingold committed
676 677 678 679 680 681
  "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))
682
               (calendar-cursor-to-date t)
Edward M. Reingold's avatar
Edward M. Reingold committed
683 684 685
             (let* ((today (calendar-current-date))
                    (year (calendar-read
                           "Year of death (>0): "
Glenn Morris's avatar
Glenn Morris committed
686
                           (lambda (x) (> x 0))
687
                           (number-to-string (calendar-extract-year today))))
Edward M. Reingold's avatar
Edward M. Reingold committed
688 689
                    (month-array calendar-month-name-array)
                    (completion-ignore-case t)
690
                    (month (cdr (assoc-string
691 692 693 694
                                 (completing-read
                                  "Month of death (name): "
                                  (mapcar 'list (append month-array nil))
                                  nil t)
695
                                 (calendar-make-alist month-array 1) t)))
Edward M. Reingold's avatar
Edward M. Reingold committed
696 697 698
                    (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
699
                          (lambda (x) (and (< 0 x) (<= x last))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
700
               (list month day year))))
701
          (death-year (calendar-extract-year death-date))
Edward M. Reingold's avatar
Edward M. Reingold committed
702 703 704
          (start-year (calendar-read
                       (format "Starting year of Yahrzeit table (>%d): "
                               death-year)
Glenn Morris's avatar
Glenn Morris committed
705
                       (lambda (x) (> x death-year))
706
                       (number-to-string (1+ death-year))))
Edward M. Reingold's avatar
Edward M. Reingold committed
707 708 709
          (end-year (calendar-read
                     (format "Ending year of Yahrzeit table (>=%d): "
                             start-year)
Glenn Morris's avatar
Glenn Morris committed
710 711
                     (lambda (x) (>= x start-year)))))
     (list death-date start-year end-year)))
Glenn Morris's avatar
Glenn Morris committed
712
  (message "Computing Yahrzeits...")
713
  (let* ((h-date (calendar-hebrew-from-absolute
Edward M. Reingold's avatar
Edward M. Reingold committed
714
                  (calendar-absolute-from-gregorian death-date)))
715
         (h-year (calendar-extract-year h-date))
716
         (i (1- start-year)))
717
    (calendar-in-read-only-buffer calendar-hebrew-yahrzeit-buffer
718 719 720 721
      (calendar-set-mode-line
       (format "Yahrzeit dates for %s = %s"
               (calendar-date-string death-date)
               (let ((calendar-month-name-array
722
                      (if (calendar-hebrew-leap-year-p h-year)
723 724 725
                          calendar-hebrew-month-name-array-leap-year
                        calendar-hebrew-month-name-array-common-year)))
                 (calendar-date-string h-date nil t))))
726
      (while (<= (setq i (1+ i)) end-year)
727 728 729
        (insert
         (calendar-date-string
          (calendar-gregorian-from-absolute
730
           (calendar-hebrew-yahrzeit
731
            h-date
732
            (calendar-extract-year
733
             (calendar-hebrew-from-absolute
734 735
              (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n"))))
  (message "Computing Yahrzeits...done"))
Edward M. Reingold's avatar
Edward M. Reingold committed
736

737 738 739 740 741 742 743 744 745 746
(defun calendar-hebrew-birthday (date year)
  "Absolute date of the anniversary of Hebrew birth DATE, in Hebrew YEAR."
  (let ((b-day (calendar-extract-day date))
        (b-month (calendar-extract-month date))
        (b-year (calendar-extract-year date)))
    ;; If it's Adar in a normal Hebrew year or Adar II in a Hebrew leap year...
    (if (= b-month (calendar-hebrew-last-month-of-year b-year))
        ;; ...then use the same day in last month of Hebrew year.
        (calendar-hebrew-to-absolute
         (list (calendar-hebrew-last-month-of-year year) b-day year))
747
      ;; Else use the normal anniversary of the birth date,
748 749
      ;; or the corresponding day in years without that date.
      (+ (calendar-hebrew-to-absolute (list b-month 1 year)) b-day -1))))
750

751 752
(defvar date)

753
;; To be called from diary-list-sexp-entries, where DATE is bound.
754
;;;###diary-autoload
Edward M. Reingold's avatar
Edward M. Reingold committed
755 756 757 758
(defun diary-hebrew-date ()
  "Hebrew calendar equivalent of date diary entry."
  (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))

759
(defvar entry)
760
(declare-function diary-ordinal-suffix "diary-lib" (n))
761 762 763 764 765 766 767 768 769 770 771 772 773 774 775

;;;###diary-autoload
(defun diary-hebrew-birthday (month day year &optional after-sunset)
  "Hebrew birthday diary entry.
Entry applies if date is birthdate (MONTH DAY YEAR), or the day before.
The order of the input parameters changes according to
`calendar-date-style' (e.g. to DAY MONTH YEAR in the European style).

Assumes the associated diary entry is the name of the person.

Although the date of birth is specified by the *civil* calendar,
this function determines the proper Hebrew calendar birthday.
If the optional argument AFTER-SUNSET is non-nil, this means the
birth occurred after local sunset on the given civil date.
In this case, the following civil date corresponds to the Hebrew birthday."
776 777
  (let* ((h-date (calendar-hebrew-from-absolute
                  (+ (calendar-absolute-from-gregorian
778
                      (diary-make-date month day year))
779
                     (if after-sunset 1 0))))
780 781 782 783 784 785 786 787 788
         (h-year (calendar-extract-year h-date))     ; birth-day
         (d (calendar-absolute-from-gregorian date)) ; today
         (h-yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
         (age (- h-yr h-year))          ; current H year - birth H-year
         (b-date (calendar-hebrew-birthday h-date h-yr)))
    (and (> age 0) (memq b-date (list d (1+ d)))
         (format "%s's %d%s Hebrew birthday%s" entry age
                 (diary-ordinal-suffix age)
                 (if (= b-date d) "" " (evening)")))))
789

790
;;;###diary-autoload
791
(defun diary-hebrew-omer (&optional mark)
Edward M. Reingold's avatar
Edward M. Reingold committed
792
  "Omer count diary entry.
793 794
Entry applies if date is within 50 days after Passover.

795
An optional parameter MARK specifies a face or single-character string to
796
use when highlighting the day in the calendar."
Edward M. Reingold's avatar
Edward M. Reingold committed
797
  (let* ((passover
798
          (calendar-hebrew-to-absolute
799
           (list 1 15 (+ (calendar-extract-year date) 3760))))
Edward M. Reingold's avatar
Edward M. Reingold committed
800 801 802 803
         (omer (- (calendar-absolute-from-gregorian date) passover))
         (week (/ omer 7))
         (day (% omer 7)))
    (if (and (> omer 0) (< omer 50))
804
        (cons mark
Glenn Morris's avatar
Glenn Morris committed
805 806 807 808 809 810 811 812 813 814 815
              (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"))))))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
816

Glenn Morris's avatar
Glenn Morris committed
817 818
(autoload 'diary-make-date "diary-lib")

819 820
(declare-function diary-ordinal-suffix "diary-lib" (n))

821
;;;###diary-autoload
822 823
(defun diary-hebrew-yahrzeit (death-month death-day death-year
                                          &optional mark after-sunset)
Glenn Morris's avatar
Glenn Morris committed
824
  "Yahrzeit diary entry--entry applies if date is Yahrzeit or the day before.
Glenn Morris's avatar
Glenn Morris committed
825 826 827 828 829
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.

830 831 832 833
If the death occurred after local sunset on the given civil date,
the following civil date corresponds to the Hebrew date of
death--set the optional parameter AFTER-SUNSET non-nil in this case.

Glenn Morris's avatar
Glenn Morris committed
834 835
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).
836

837
An optional parameter MARK specifies a face or single-character string to
838
use when highlighting the day in the calendar."
Edward M. Reingold's avatar
Edward M. Reingold committed
839
  (let* ((h-date (calendar-hebrew-from-absolute
840 841 842
                  (+ (calendar-absolute-from-gregorian
                      (diary-make-date death-month death-day death-year))
                     (if after-sunset 1 0))))
843
         (h-year (calendar-extract-year h-date))
Edward M. Reingold's avatar
Edward M. Reingold committed
844
         (d (calendar-absolute-from-gregorian date))
845
         (yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
Edward M. Reingold's avatar
Edward M. Reingold committed
846
         (diff (- yr h-year))
847
         (y (calendar-hebrew-yahrzeit h-date yr)))
Edward M. Reingold's avatar
Edward M. Reingold committed
848
    (if (and (> diff 0) (or (= y d) (= y (1+ d))))
849
        (cons mark
Glenn Morris's avatar
Glenn Morris committed
850 851 852 853
              (format "Yahrzeit of %s%s: %d%s anniversary"
                      entry
                      (if (= y d) "" " (evening)")
                      diff
854 855
                      (diary-ordinal-suffix diff))))))

856
;;;###diary-autoload
857
(defun diary-hebrew-rosh-hodesh (&optional mark)
Edward M. Reingold's avatar
Edward M. Reingold committed
858
  "Rosh Hodesh diary entry.
859 860
Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.

861
An optional parameter MARK specifies a face or single-character string to
862
use when highlighting the day in the calendar."
Edward M. Reingold's avatar
Edward M. Reingold committed
863 864
  (let* ((d (calendar-absolute-from-gregorian date))
         (h-date (calendar-hebrew-from-absolute d))
865 866 867
         (h-month (calendar-extract-month h-date))
         (h-day (calendar-extract-day h-date))
         (h-year (calendar-extract-year h-date))
868 869
         (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
870 871 872 873 874
         (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)))
875
         (h-yesterday (calendar-extract-day
Edward M. Reingold's avatar
Edward M. Reingold committed
876 877
                       (calendar-hebrew-from-absolute (1- d)))))
    (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
878
        (cons mark
Glenn Morris's avatar
Glenn Morris committed
879 880 881 882 883 884 885 886 887