aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/calendar/calendar.el82
1 files changed, 59 insertions, 23 deletions
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 902d8f58c49..8f5985ddaab 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1206,11 +1206,16 @@ with descriptive strings such as
1206 "Name of the buffer used for the lunar phases.") 1206 "Name of the buffer used for the lunar phases.")
1207 1207
1208(defmacro increment-calendar-month (mon yr n) 1208(defmacro increment-calendar-month (mon yr n)
1209 "Move the variables MON and YR to the month and year by N months. 1209 "Increment the variables MON and YR by N months.
1210Forward if N is positive or backward if N is negative." 1210Forward if N is positive or backward if N is negative.
1211 `(let ((macro-y (+ (* ,yr 12) ,mon -1 ,n))) 1211A negative YR is interpreted as BC; -1 being 1 BC, and so on."
1212 (setq ,mon (1+ (% macro-y 12))) 1212 `(let (macro-y)
1213 (setq ,yr (/ macro-y 12)))) 1213 (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc
1214 (setq macro-y (+ (* ,yr 12) ,mon -1 ,n)
1215 ,mon (1+ (mod macro-y 12))
1216 ,yr (/ macro-y 12))
1217 (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
1218 (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
1214 1219
1215(defmacro calendar-for-loop (var from init to final do &rest body) 1220(defmacro calendar-for-loop (var from init to final do &rest body)
1216 "Execute a for loop." 1221 "Execute a for loop."
@@ -1270,7 +1275,10 @@ Forward if N is positive or backward if N is negative."
1270 (car (cdr (cdr date)))) 1275 (car (cdr (cdr date))))
1271 1276
1272(defsubst calendar-leap-year-p (year) 1277(defsubst calendar-leap-year-p (year)
1273 "Return t if YEAR is a Gregorian leap year." 1278 "Return t if YEAR is a Gregorian leap year.
1279A negative year is interpreted as BC; -1 being 1 BC, and so on."
1280 ;; 1 BC = 0 AD, 2 BC acts like 1 AD, etc.
1281 (if (< year 0) (setq year (1- (abs year))))
1274 (and (zerop (% year 4)) 1282 (and (zerop (% year 4))
1275 (or (not (zerop (% year 100))) 1283 (or (not (zerop (% year 100)))
1276 (zerop (% year 400))))) 1284 (zerop (% year 400)))))
@@ -1310,13 +1318,30 @@ while (calendar-day-number '(12 31 1980)) returns 366."
1310 1318
1311(defsubst calendar-absolute-from-gregorian (date) 1319(defsubst calendar-absolute-from-gregorian (date)
1312 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. 1320 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
1313The Gregorian date Sunday, December 31, 1 BC is imaginary." 1321The Gregorian date Sunday, December 31, 1 BC is imaginary.
1314 (let ((prior-years (1- (extract-calendar-year date)))) 1322DATE is a list of the form (month day year). A negative year is
1315 (+ (calendar-day-number date);; Days this year 1323interpreted as BC; -1 being 1 BC, and so on. Dates before 12/31/1 BC
1316 (* 365 prior-years);; + Days in prior years 1324return negative results."
1317 (/ prior-years 4);; + Julian leap years 1325 (let ((year (extract-calendar-year date))
1318 (- (/ prior-years 100));; - century years 1326 offset-years)
1319 (/ prior-years 400))));; + Gregorian leap years 1327 (cond ((= year 0)
1328 (error "There was no year zero"))
1329 ((> year 0)
1330 (setq offset-years (1- year))
1331 (+ (calendar-day-number date) ; Days this year
1332 (* 365 offset-years) ; + Days in prior years
1333 (/ offset-years 4) ; + Julian leap years
1334 (- (/ offset-years 100)) ; - century years
1335 (/ offset-years 400))) ; + Gregorian leap years
1336 (t
1337 ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).
1338 (setq offset-years (abs (1+ year)))
1339 (- (calendar-day-number date)
1340 (* 365 offset-years)
1341 (/ offset-years 4)
1342 (- (/ offset-years 100))
1343 (/ offset-years 400)
1344 (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC
1320 1345
1321(autoload 'calendar-goto-today "cal-move" 1346(autoload 'calendar-goto-today "cal-move"
1322 "Reposition the calendar window so the current date is visible." 1347 "Reposition the calendar window so the current date is visible."
@@ -1888,9 +1913,10 @@ Or, for optional MON, YR."
1888 (run-hooks 'today-invisible-calendar-hook))))) 1913 (run-hooks 'today-invisible-calendar-hook)))))
1889 1914
1890(defun generate-calendar (month year) 1915(defun generate-calendar (month year)
1891 "Generate a three-month Gregorian calendar centered around MONTH, YEAR." 1916 "Generate a three-month Gregorian calendar centered around MONTH, YEAR.
1892 (if (< (+ month (* 12 (1- year))) 2) 1917A negative YEAR is interpreted as BC; -1 being 1 BC, and so on.
1893 (error "Months before February, 1 AD are not available")) 1918Note that while calendars can be displayed for years BC, some functions (eg
1919motion, complex holiday functions) will not work correctly for such dates."
1894 (setq displayed-month month) 1920 (setq displayed-month month)
1895 (setq displayed-year year) 1921 (setq displayed-year year)
1896 (erase-buffer) 1922 (erase-buffer)
@@ -1904,7 +1930,7 @@ Or, for optional MON, YR."
1904The calendar is inserted at the top of the buffer in which point is currently 1930The calendar is inserted at the top of the buffer in which point is currently
1905located, but indented INDENT spaces. The indentation is done from the first 1931located, but indented INDENT spaces. The indentation is done from the first
1906character on the line and does not disturb the first INDENT characters on the 1932character on the line and does not disturb the first INDENT characters on the
1907line." 1933line. A negative YEAR is interpreted as BC; -1 being 1 BC, and so on."
1908 (let* ((blank-days;; at start of month 1934 (let* ((blank-days;; at start of month
1909 (mod 1935 (mod
1910 (- (calendar-day-of-week (list month 1 year)) 1936 (- (calendar-day-of-week (list month 1 year))
@@ -2395,7 +2421,8 @@ ERROR is t, otherwise just returns nil."
2395(defun calendar-gregorian-from-absolute (date) 2421(defun calendar-gregorian-from-absolute (date)
2396 "Compute the list (month day year) corresponding to the absolute DATE. 2422 "Compute the list (month day year) corresponding to the absolute DATE.
2397The absolute date is the number of days elapsed since the (imaginary) 2423The absolute date is the number of days elapsed since the (imaginary)
2398Gregorian date Sunday, December 31, 1 BC." 2424Gregorian date Sunday, December 31, 1 BC. This function does not
2425handle dates in years BC."
2399;; See the footnote on page 384 of ``Calendrical Calculations, Part II: 2426;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
2400;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. 2427;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M.
2401;; Clamen, Software--Practice and Experience, Volume 23, Number 4 2428;; Clamen, Software--Practice and Experience, Volume 23, Number 4
@@ -2500,8 +2527,8 @@ If optional NODAY is t, does not ask for day, but just returns
2500\(month nil year); if NODAY is any other non-nil value the value returned is 2527\(month nil year); if NODAY is any other non-nil value the value returned is
2501\(month year)" 2528\(month year)"
2502 (let* ((year (calendar-read 2529 (let* ((year (calendar-read
2503 "Year (>0): " 2530 "Year: "
2504 (lambda (x) (> x 0)) 2531 (lambda (x) (not (zerop x)))
2505 (int-to-string (extract-calendar-year 2532 (int-to-string (extract-calendar-year
2506 (calendar-current-date))))) 2533 (calendar-current-date)))))
2507 (month-array calendar-month-name-array) 2534 (month-array calendar-month-name-array)
@@ -2523,7 +2550,11 @@ If optional NODAY is t, does not ask for day, but just returns
2523 year)))) 2550 year))))
2524 2551
2525(defun calendar-interval (mon1 yr1 mon2 yr2) 2552(defun calendar-interval (mon1 yr1 mon2 yr2)
2526 "The number of months difference between MON1, YR1 and MON2, YR2." 2553 "The number of months difference between MON1, YR1 and MON2, YR2.
2554The result is positive if the second date is later than the first.
2555Negative years are interpreted as years BC; -1 being 1 BC, and so on."
2556 (if (< yr1 0) (setq yr1 (1+ yr1))) ; -1 BC -> 0 AD, etc
2557 (if (< yr2 0) (setq yr2 (1+ yr2)))
2527 (+ (* 12 (- yr2 yr1)) 2558 (+ (* 12 (- yr2 yr1))
2528 (- mon2 mon1))) 2559 (- mon2 mon1)))
2529 2560
@@ -2654,8 +2685,10 @@ argument ABBREV is non-nil, in which case
2654 (1- month))) 2685 (1- month)))
2655 2686
2656(defun calendar-day-of-week (date) 2687(defun calendar-day-of-week (date)
2657 "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc." 2688 "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc.
2658 (% (calendar-absolute-from-gregorian date) 7)) 2689DATE is a list of the form (month day year). A negative year is
2690interpreted as BC; -1 being 1 BC, and so on."
2691 (mod (calendar-absolute-from-gregorian date) 7))
2659 2692
2660(defun calendar-unmark () 2693(defun calendar-unmark ()
2661 "Delete all diary/holiday marks/highlighting from the calendar." 2694 "Delete all diary/holiday marks/highlighting from the calendar."
@@ -2678,6 +2711,9 @@ argument ABBREV is non-nil, in which case
2678 (year (extract-calendar-year date))) 2711 (year (extract-calendar-year date)))
2679 (and (<= 1 month) (<= month 12) 2712 (and (<= 1 month) (<= month 12)
2680 (<= 1 day) (<= day (calendar-last-day-of-month month year)) 2713 (<= 1 day) (<= day (calendar-last-day-of-month month year))
2714 ;; BC dates left as non-legal, to suppress errors from
2715 ;; complex holiday algorithms not suitable for years BC.
2716 ;; Note there are side effects on calendar navigation.
2681 (<= 1 year)))) 2717 (<= 1 year))))
2682 2718
2683(defun calendar-date-equal (date1 date2) 2719(defun calendar-date-equal (date1 date2)