[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/calendar/cal-hebrew.el [lexbind]
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/calendar/cal-hebrew.el [lexbind] |
|
Date: |
Tue, 14 Oct 2003 19:42:18 -0400 |
Index: emacs/lisp/calendar/cal-hebrew.el
diff -c emacs/lisp/calendar/cal-hebrew.el:1.12.2.1
emacs/lisp/calendar/cal-hebrew.el:1.12.2.2
*** emacs/lisp/calendar/cal-hebrew.el:1.12.2.1 Fri Apr 4 01:20:15 2003
--- emacs/lisp/calendar/cal-hebrew.el Tue Oct 14 19:42:13 2003
***************
*** 1,6 ****
;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
! ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
;; Author: Nachum Dershowitz <address@hidden>
;; Edward M. Reingold <address@hidden>
--- 1,6 ----
;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
! ;; Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
;; Author: Nachum Dershowitz <address@hidden>
;; Edward M. Reingold <address@hidden>
***************
*** 41,69 ****
;;; Code:
! (require 'calendar)
! (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))
! (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
! (1- (extract-calendar-month greg-date))))
! (day)
! (year (+ 3760 (extract-calendar-year greg-date))))
! (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
! (setq year (1+ year)))
! (let ((length (hebrew-calendar-last-month-of-year year)))
! (while (> date
! (calendar-absolute-from-hebrew
! (list month
! (hebrew-calendar-last-day-of-month month year)
! year)))
! (setq month (1+ (% month length)))))
! (setq day (1+
! (- date (calendar-absolute-from-hebrew (list month 1 year)))))
! (list month day year)))
(defun hebrew-calendar-leap-year-p (year)
"t if YEAR is a Hebrew calendar leap year."
--- 41,50 ----
;;; Code:
! (defvar displayed-month)
! (defvar displayed-year)
! (require 'calendar)
(defun hebrew-calendar-leap-year-p (year)
"t if YEAR is a Hebrew calendar leap year."
***************
*** 75,89 ****
13
12))
- (defun hebrew-calendar-last-day-of-month (month year)
- "The last day of MONTH in YEAR."
- (if (or (memq month (list 2 4 6 10 13))
- (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
- (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
- (and (= month 9) (hebrew-calendar-short-kislev-p year)))
- 29
- 30))
-
(defun hebrew-calendar-elapsed-days (year)
"Days from Sun. prior to start of Hebrew calendar to mean conjunction of
Tishri of Hebrew YEAR."
(let* ((months-elapsed
--- 56,61 ----
***************
*** 133,138 ****
--- 105,119 ----
"t if Kislev is short in Hebrew YEAR."
(= (% (hebrew-calendar-days-in-year year) 10) 3))
+ (defun hebrew-calendar-last-day-of-month (month year)
+ "The last day of MONTH in YEAR."
+ (if (or (memq month (list 2 4 6 10 13))
+ (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
+ (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
+ (and (= month 9) (hebrew-calendar-short-kislev-p year)))
+ 29
+ 30))
+
(defun calendar-absolute-from-hebrew (date)
"Absolute date of Hebrew DATE.
The absolute date is the number of days elapsed since the (imaginary)
***************
*** 156,168 ****
(hebrew-calendar-elapsed-days year);; Days in prior years.
-1373429))) ;; Days elapsed before absolute date 1.
(defvar calendar-hebrew-month-name-array-common-year
["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
! "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"])
(defvar calendar-hebrew-month-name-array-leap-year
["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
! "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
(defun calendar-hebrew-date-string (&optional date)
"String of Hebrew date before sunset of Gregorian DATE.
--- 137,173 ----
(hebrew-calendar-elapsed-days year);; Days in prior years.
-1373429))) ;; Days elapsed before absolute date 1.
+ (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))
+ (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
+ (1- (extract-calendar-month greg-date))))
+ (day)
+ (year (+ 3760 (extract-calendar-year greg-date))))
+ (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
+ (setq year (1+ year)))
+ (let ((length (hebrew-calendar-last-month-of-year year)))
+ (while (> date
+ (calendar-absolute-from-hebrew
+ (list month
+ (hebrew-calendar-last-day-of-month month year)
+ year)))
+ (setq month (1+ (% month length)))))
+ (setq day (1+
+ (- date (calendar-absolute-from-hebrew (list month 1 year)))))
+ (list month day year)))
+
(defvar calendar-hebrew-month-name-array-common-year
["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
! "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"]
! "Array of strings giving the names of the Hebrew months in a common year.")
(defvar calendar-hebrew-month-name-array-leap-year
["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
! "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"]
! "Array of strings giving the names of the Hebrew months in a leap year.")
(defun calendar-hebrew-date-string (&optional date)
"String of Hebrew date before sunset of Gregorian DATE.
***************
*** 525,533 ****
(car d)))
(backup (equal (car (car d)) 'backup))
(dayname
! (concat
! (calendar-day-name gdate) "\\|"
! (substring (calendar-day-name gdate) 0 3) ".?"))
(calendar-month-name-array
calendar-hebrew-month-name-array-leap-year)
(monthname
--- 530,538 ----
(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
***************
*** 573,579 ****
gdate
(buffer-substring-no-properties entry-start (point))
(buffer-substring-no-properties
! (1+ date-start) (1- entry-start)))))))
(setq d (cdr d))))
(setq gdate
(calendar-gregorian-from-absolute
--- 578,585 ----
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
***************
*** 581,586 ****
--- 587,666 ----
(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.
+ A value of 0 in any position is a wildcard."
+ (save-excursion
+ (set-buffer calendar-buffer)
+ (if (and (/= 0 month) (/= 0 day))
+ (if (/= 0 year)
+ ;; Fully specified Hebrew date.
+ (let ((date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-hebrew
+ (list month day year)))))
+ (if (calendar-date-is-visible-p date)
+ (mark-visible-calendar-date date)))
+ ;; Month and day in any year--this taken from the holiday stuff.
+ (if (memq displayed-month;; This test is only to speed things up a
+ (list ;; bit; it works fine without the test
too.
+ (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))))
+ (let ((m1 displayed-month)
+ (y1 displayed-year)
+ (m2 displayed-month)
+ (y2 displayed-year)
+ (year))
+ (increment-calendar-month m1 y1 -1)
+ (increment-calendar-month m2 y2 1)
+ (let* ((start-date (calendar-absolute-from-gregorian
+ (list m1 1 y1)))
+ (end-date (calendar-absolute-from-gregorian
+ (list m2
+ (calendar-last-day-of-month m2 y2)
+ y2)))
+ (hebrew-start
+ (calendar-hebrew-from-absolute start-date))
+ (hebrew-end (calendar-hebrew-from-absolute end-date))
+ (hebrew-y1 (extract-calendar-year hebrew-start))
+ (hebrew-y2 (extract-calendar-year hebrew-end)))
+ (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
+ (let ((date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-hebrew
+ (list month day year)))))
+ (if (calendar-date-is-visible-p date)
+ (mark-visible-calendar-date date)))))))
+ ;; Not one of the simple cases--check all visible dates for match.
+ ;; Actually, the following code takes care of ALL of the cases, but
+ ;; it's much too slow to be used for the simple (common) cases.
+ (let ((m displayed-month)
+ (y displayed-year)
+ (first-date)
+ (last-date))
+ (increment-calendar-month m y -1)
+ (setq first-date
+ (calendar-absolute-from-gregorian
+ (list m 1 y)))
+ (increment-calendar-month m y 2)
+ (setq last-date
+ (calendar-absolute-from-gregorian
+ (list m (calendar-last-day-of-month m y) y)))
+ (calendar-for-loop date from first-date to last-date do
+ (let* ((h-date (calendar-hebrew-from-absolute date))
+ (h-month (extract-calendar-month h-date))
+ (h-day (extract-calendar-day h-date))
+ (h-year (extract-calendar-year h-date)))
+ (and (or (zerop month)
+ (= month h-month))
+ (or (zerop day)
+ (= day h-day))
+ (or (zerop year)
+ (= year h-year))
+ (mark-visible-calendar-date
+ (calendar-gregorian-from-absolute date)))))))))
+
(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
***************
*** 598,608 ****
((date-form (if (equal (car (car d)) 'backup)
(cdr (car d))
(car d)));; ignore 'backup directive
! (dayname (diary-name-pattern calendar-day-name-array))
(monthname
! (concat
! (diary-name-pattern calendar-hebrew-month-name-array-leap-year t)
! "\\|\\*"))
(month "[0-9]+\\|\\*")
(day "[0-9]+\\|\\*")
(year "[0-9]+\\|\\*")
--- 678,689 ----
((date-form (if (equal (car (car d)) 'backup)
(cdr (car d))
(car d)));; ignore 'backup directive
! (dayname (diary-name-pattern calendar-day-name-array
! calendar-day-abbrev-array))
(monthname
! (format "%s\\|\\*"
! (diary-name-pattern
! calendar-hebrew-month-name-array-leap-year)))
(month "[0-9]+\\|\\*")
(day "[0-9]+\\|\\*")
(year "[0-9]+\\|\\*")
***************
*** 672,770 ****
(string-to-int y-str)))))
(if dd-name
(mark-calendar-days-named
! (cdr (assoc-ignore-case
! (substring dd-name 0 3)
! (calendar-make-alist
! calendar-day-name-array
! 0
! '(lambda (x) (substring x 0 3))))))
(if mm-name
! (if (string-equal mm-name "*")
! (setq mm 0)
! (setq
! mm
! (cdr
! (assoc-ignore-case
! mm-name
! (calendar-make-alist
! calendar-hebrew-month-name-array-leap-year))))))
(mark-hebrew-calendar-date-pattern mm dd yy)))))
(setq d (cdr d)))))
- (defun mark-hebrew-calendar-date-pattern (month day year)
- "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
- A value of 0 in any position is a wildcard."
- (save-excursion
- (set-buffer calendar-buffer)
- (if (and (/= 0 month) (/= 0 day))
- (if (/= 0 year)
- ;; Fully specified Hebrew date.
- (let ((date (calendar-gregorian-from-absolute
- (calendar-absolute-from-hebrew
- (list month day year)))))
- (if (calendar-date-is-visible-p date)
- (mark-visible-calendar-date date)))
- ;; Month and day in any year--this taken from the holiday stuff.
- (if (memq displayed-month;; This test is only to speed things up a
- (list ;; bit; it works fine without the test
too.
- (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))))
- (let ((m1 displayed-month)
- (y1 displayed-year)
- (m2 displayed-month)
- (y2 displayed-year)
- (year))
- (increment-calendar-month m1 y1 -1)
- (increment-calendar-month m2 y2 1)
- (let* ((start-date (calendar-absolute-from-gregorian
- (list m1 1 y1)))
- (end-date (calendar-absolute-from-gregorian
- (list m2
- (calendar-last-day-of-month m2 y2)
- y2)))
- (hebrew-start
- (calendar-hebrew-from-absolute start-date))
- (hebrew-end (calendar-hebrew-from-absolute end-date))
- (hebrew-y1 (extract-calendar-year hebrew-start))
- (hebrew-y2 (extract-calendar-year hebrew-end)))
- (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
- (let ((date (calendar-gregorian-from-absolute
- (calendar-absolute-from-hebrew
- (list month day year)))))
- (if (calendar-date-is-visible-p date)
- (mark-visible-calendar-date date)))))))
- ;; Not one of the simple cases--check all visible dates for match.
- ;; Actually, the following code takes care of ALL of the cases, but
- ;; it's much too slow to be used for the simple (common) cases.
- (let ((m displayed-month)
- (y displayed-year)
- (first-date)
- (last-date))
- (increment-calendar-month m y -1)
- (setq first-date
- (calendar-absolute-from-gregorian
- (list m 1 y)))
- (increment-calendar-month m y 2)
- (setq last-date
- (calendar-absolute-from-gregorian
- (list m (calendar-last-day-of-month m y) y)))
- (calendar-for-loop date from first-date to last-date do
- (let* ((h-date (calendar-hebrew-from-absolute date))
- (h-month (extract-calendar-month h-date))
- (h-day (extract-calendar-day h-date))
- (h-year (extract-calendar-year h-date)))
- (and (or (zerop month)
- (= month h-month))
- (or (zerop day)
- (= day h-day))
- (or (zerop year)
- (= year h-year))
- (mark-visible-calendar-date
- (calendar-gregorian-from-absolute date)))))))))
-
(defun insert-hebrew-diary-entry (arg)
"Insert a diary entry.
For the Hebrew date corresponding to the date indicated by point.
--- 753,773 ----
(string-to-int y-str)))))
(if dd-name
(mark-calendar-days-named
! (cdr (assoc-ignore-case dd-name
! (calendar-make-alist
! calendar-day-name-array
! 0 nil calendar-day-abbrev-array))))
(if mm-name
! (setq mm
! (if (string-equal mm-name "*") 0
! (cdr
! (assoc-ignore-case
! mm-name
! (calendar-make-alist
! calendar-hebrew-month-name-array-leap-year))))))
(mark-hebrew-calendar-date-pattern mm dd yy)))))
(setq d (cdr d)))))
(defun insert-hebrew-diary-entry (arg)
"Insert a diary entry.
For the Hebrew date corresponding to the date indicated by point.
***************
*** 1016,1021 ****
--- 1019,1044 ----
h-year))
0 h-month)))))))))
+ (defvar hebrew-calendar-parashiot-names
+ ["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth"
+ "Vayetze" "Vayishlah" "Vayeshev" "Mikketz" "Vayiggash" "Vayhi"
+ "Shemoth" "Vaera" "Bo" "Beshallah" "Yithro" "Mishpatim"
+ "Terumah" "Tetzavveh" "Ki Tissa" "Vayakhel" "Pekudei" "Vayikra"
+ "Tzav" "Shemini" "Tazria" "Metzora" "Aharei Moth" "Kedoshim"
+ "Emor" "Behar" "Behukkotai" "Bemidbar" "Naso"
"Behaalot'cha"
+ "Shelah L'cha" "Korah" "Hukkath" "Balak" "Pinhas" "Mattoth"
+ "Masei" "Devarim" "Vaethanan" "Ekev" "Reeh" "Shofetim"
+ "Ki Tetze" "Ki Tavo" "Nitzavim" "Vayelech" "Haazinu"]
+ "The names of the parashiot in the Torah.")
+
+ (defun hebrew-calendar-parasha-name (p)
+ "Name(s) corresponding to parasha P."
+ (if (arrayp p);; combined parasha
+ (format "%s/%s"
+ (aref hebrew-calendar-parashiot-names (aref p 0))
+ (aref hebrew-calendar-parashiot-names (aref p 1)))
+ (aref hebrew-calendar-parashiot-names p)))
+
(defun diary-parasha (&optional mark)
"Parasha diary entry--entry applies if date is a Saturday.
***************
*** 1061,1078 ****
(hebrew-calendar-parasha-name (cdr
parasha))))
(hebrew-calendar-parasha-name parasha)))))))))
- (defvar hebrew-calendar-parashiot-names
- ["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth"
- "Vayetze" "Vayishlah" "Vayeshev" "Mikketz" "Vayiggash" "Vayhi"
- "Shemoth" "Vaera" "Bo" "Beshallah" "Yithro" "Mishpatim"
- "Terumah" "Tetzavveh" "Ki Tissa" "Vayakhel" "Pekudei" "Vayikra"
- "Tzav" "Shemini" "Tazria" "Metzora" "Aharei Moth" "Kedoshim"
- "Emor" "Behar" "Behukkotai" "Bemidbar" "Naso"
"Behaalot'cha"
- "Shelah L'cha" "Korah" "Hukkath" "Balak" "Pinhas" "Mattoth"
- "Masei" "Devarim" "Vaethanan" "Ekev" "Reeh" "Shofetim"
- "Ki Tetze" "Ki Tavo" "Nitzavim" "Vayelech" "Haazinu"]
- "The names of the parashiot in the Torah.")
-
;; The seven ordinary year types (keviot)
(defconst hebrew-calendar-year-Saturday-incomplete-Sunday
--- 1084,1089 ----
***************
*** 1192,1205 ****
Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
have 30 days), and has Passover start on Tuesday.")
- (defun hebrew-calendar-parasha-name (p)
- "Name(s) corresponding to parasha P."
- (if (arrayp p);; combined parasha
- (format "%s/%s"
- (aref hebrew-calendar-parashiot-names (aref p 0))
- (aref hebrew-calendar-parashiot-names (aref p 1)))
- (aref hebrew-calendar-parashiot-names p)))
-
(provide 'cal-hebrew)
;;; cal-hebrew.el ends here
--- 1203,1209 ----
Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
have 30 days), and has Passover start on Tuesday.")
(provide 'cal-hebrew)
+ ;;; arch-tag: aaab6718-7712-42ac-a32d-28fe1f944f3c
;;; cal-hebrew.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/calendar/cal-hebrew.el [lexbind],
Miles Bader <=