diff options
Diffstat (limited to 'lisp/calendar/cal-hebrew.el')
| -rw-r--r-- | lisp/calendar/cal-hebrew.el | 165 |
1 files changed, 89 insertions, 76 deletions
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 78cce12ecc3..a991b965650 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -301,6 +301,9 @@ nil if it is not visible in the current calendar window." (if (calendar-date-is-visible-p date) (list (list date string)))))))) +;; h-r-h-e should be called from holidays code. +(declare-function holiday-filter-visible-calendar "holidays" (l)) + (defun holiday-rosh-hashanah-etc () "List of dates related to Rosh Hashanah, as visible in calendar window." (if (or (< displayed-month 8) @@ -352,11 +355,11 @@ nil if it is not visible in the current calendar window." (list (calendar-gregorian-from-absolute (+ abs-r-h 20)) "Hoshanah Rabbah"))) (output-list - (filter-visible-calendar-holidays mandatory))) + (holiday-filter-visible-calendar mandatory))) (if all-hebrew-calendar-holidays (setq output-list (append - (filter-visible-calendar-holidays optional) + (holiday-filter-visible-calendar optional) output-list))) output-list))) @@ -372,7 +375,7 @@ nil if it is not visible in the current calendar window." (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))) (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) - (filter-visible-calendar-holidays + (holiday-filter-visible-calendar (list (list (calendar-gregorian-from-absolute (1- abs-h)) "Erev Hanukkah") @@ -469,11 +472,11 @@ nil if it is not visible in the current calendar window." (list (calendar-gregorian-from-absolute (+ abs-p 51)) "Shavuot (second day)"))) (output-list - (filter-visible-calendar-holidays mandatory))) + (holiday-filter-visible-calendar mandatory))) (if all-hebrew-calendar-holidays (setq output-list (append - (filter-visible-calendar-holidays optional) + (holiday-filter-visible-calendar optional) output-list))) output-list))) @@ -485,7 +488,7 @@ nil if it is not visible in the current calendar window." (let* ((abs-t-a (calendar-absolute-from-hebrew (list 5 9 (+ displayed-year 3760))))) - (filter-visible-calendar-holidays + (holiday-filter-visible-calendar (list (list (calendar-gregorian-from-absolute (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21))) @@ -500,6 +503,10 @@ nil if it is not visible in the current calendar window." (calendar-dayname-on-or-before 6 (+ abs-t-a 7))) "Shabbat Nahamu")))))) +;; l-h-d-e should be called from diary code. +(declare-function add-to-diary-list "diary-lib" + (date string specifier &optional marker globcolor literal)) + (defun list-hebrew-diary-entries () "Add any Hebrew date entries from the diary file to `diary-entries-list'. Hebrew date diary entries must be prefaced by `hebrew-diary-entry-symbol' @@ -516,76 +523,76 @@ not be marked in the calendar. This function is provided for use with the (diary-modified (buffer-modified-p)) (gdate original-date) (mark (regexp-quote diary-nonmarking-symbol))) - (calendar-for-loop i from 1 to number do - (let* ((d diary-date-forms) - (hdate (calendar-hebrew-from-absolute - (calendar-absolute-from-gregorian gdate))) - (month (extract-calendar-month hdate)) - (day (extract-calendar-day hdate)) - (year (extract-calendar-year hdate))) - (while d - (let* - ((date-form (if (equal (car (car d)) 'backup) - (cdr (car d)) - (car d))) - (backup (equal (car (car d)) 'backup)) - (dayname - (format "%s\\|%s\\.?" - (calendar-day-name gdate) - (calendar-day-name gdate 'abbrev))) - (calendar-month-name-array - calendar-hebrew-month-name-array-leap-year) - (monthname - (concat - "\\*\\|" - (calendar-month-name month))) - (month (concat "\\*\\|0*" (int-to-string month))) - (day (concat "\\*\\|0*" (int-to-string day))) - (year - (concat - "\\*\\|0*" (int-to-string year) - (if abbreviated-calendar-year - (concat "\\|" (int-to-string (% year 100))) - ""))) - (regexp - (concat - "\\(\\`\\|\^M\\|\n\\)" mark "?" - (regexp-quote hebrew-diary-entry-symbol) - "\\(" - (mapconcat 'eval date-form "\\)\\(") - "\\)")) - (case-fold-search t)) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (if backup (re-search-backward "\\<" nil t)) - (if (and (or (char-equal (preceding-char) ?\^M) - (char-equal (preceding-char) ?\n)) - (not (looking-at " \\|\^I"))) - ;; Diary entry that consists only of date. - (backward-char 1) - ;; Found a nonempty diary entry--make it visible and - ;; add it to the list. - (let ((entry-start (point)) - (date-start)) - (re-search-backward "\^M\\|\n\\|\\`") - (setq date-start (point)) - (re-search-forward "\^M\\|\n" nil t 2) - (while (looking-at " \\|\^I") - (re-search-forward "\^M\\|\n" nil t)) - (backward-char 1) - (subst-char-in-region date-start (point) ?\^M ?\n t) - (add-to-diary-list - gdate - (buffer-substring-no-properties entry-start (point)) - (buffer-substring-no-properties - (1+ date-start) (1- entry-start)) - (copy-marker entry-start)))))) - (setq d (cdr d)))) - (setq gdate - (calendar-gregorian-from-absolute - (1+ (calendar-absolute-from-gregorian gdate))))) - (set-buffer-modified-p diary-modified)) - (goto-char (point-min)))) + (dotimes (idummy number) + (let* ((d diary-date-forms) + (hdate (calendar-hebrew-from-absolute + (calendar-absolute-from-gregorian gdate))) + (month (extract-calendar-month hdate)) + (day (extract-calendar-day hdate)) + (year (extract-calendar-year hdate))) + (while d + (let* + ((date-form (if (equal (car (car d)) 'backup) + (cdr (car d)) + (car d))) + (backup (equal (car (car d)) 'backup)) + (dayname + (format "%s\\|%s\\.?" + (calendar-day-name gdate) + (calendar-day-name gdate 'abbrev))) + (calendar-month-name-array + calendar-hebrew-month-name-array-leap-year) + (monthname + (concat + "\\*\\|" + (calendar-month-name month))) + (month (concat "\\*\\|0*" (int-to-string month))) + (day (concat "\\*\\|0*" (int-to-string day))) + (year + (concat + "\\*\\|0*" (int-to-string year) + (if abbreviated-calendar-year + (concat "\\|" (int-to-string (% year 100))) + ""))) + (regexp + (concat + "\\(\\`\\|\^M\\|\n\\)" mark "?" + (regexp-quote hebrew-diary-entry-symbol) + "\\(" + (mapconcat 'eval date-form "\\)\\(") + "\\)")) + (case-fold-search t)) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (if backup (re-search-backward "\\<" nil t)) + (if (and (or (char-equal (preceding-char) ?\^M) + (char-equal (preceding-char) ?\n)) + (not (looking-at " \\|\^I"))) + ;; Diary entry that consists only of date. + (backward-char 1) + ;; Found a nonempty diary entry--make it visible and + ;; add it to the list. + (let ((entry-start (point)) + (date-start)) + (re-search-backward "\^M\\|\n\\|\\`") + (setq date-start (point)) + (re-search-forward "\^M\\|\n" nil t 2) + (while (looking-at " \\|\^I") + (re-search-forward "\^M\\|\n" nil t)) + (backward-char 1) + (subst-char-in-region date-start (point) ?\^M ?\n t) + (add-to-diary-list + gdate + (buffer-substring-no-properties entry-start (point)) + (buffer-substring-no-properties + (1+ date-start) (1- entry-start)) + (copy-marker entry-start)))))) + (setq d (cdr d)))) + (setq gdate + (calendar-gregorian-from-absolute + (1+ (calendar-absolute-from-gregorian gdate))))) + (set-buffer-modified-p diary-modified)) + (goto-char (point-min)))) (defun mark-hebrew-calendar-date-pattern (month day year) "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR. @@ -661,6 +668,12 @@ A value of 0 in any position is a wildcard." (mark-visible-calendar-date (calendar-gregorian-from-absolute date))))))))) +(declare-function diary-name-pattern "diary-lib" + (string-array &optional abbrev-array paren)) + +(declare-function mark-calendar-days-named "diary-lib" + (dayname &optional color)) + (defun mark-hebrew-diary-entries () "Mark days in the calendar window that have Hebrew date diary entries. Each entry in diary-file (or included files) visible in the calendar window |