+;;(defun extract-calendar-year (date)
+;; "Extract the year part of DATE which has the form (month day year)."
+;; (car (cdr (cdr date))))
+
+(defmacro calendar-leap-year-p (year)
+ "Returns t if YEAR is a Gregorian leap year."
+ (` (and
+ (zerop (% (, year) 4))
+ (or (not (zerop (% (, year) 100)))
+ (zerop (% (, year) 400))))))
+;;(defun calendar-leap-year-p (year)
+;; "Returns t if YEAR is a Gregorian leap year."
+;; (and
+;; (zerop (% year 4))
+;; (or ((not (zerop (% year 100))))
+;; (zerop (% year 400)))))
+;;
+;; The foregoing is a bit faster, but not as clear as the following:
+;;
+;;(defmacro calendar-leap-year-p (year)
+;; "Returns t if YEAR is a Gregorian leap year."
+;; (` (or
+;; (and (= (% (, year) 4) 0)
+;; (/= (% (, year) 100) 0))
+;; (= (% (, year) 400) 0))))
+;;(defun calendar-leap-year-p (year)
+;; "Returns t if YEAR is a Gregorian leap year."
+;; (or
+;; (and (= (% year 4) 0)
+;; (/= (% year 100) 0))
+;; (= (% year 400) 0)))
+
+(defmacro calendar-last-day-of-month (month year)
+ "The last day in MONTH during YEAR."
+ (` (if (and
+ (, (macroexpand (` (calendar-leap-year-p (, year)))))
+ (= (, month) 2))
+ 29
+ (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- (, month))))))
+;;(defun calendar-last-day-of-month (month year)
+;; "The last day in MONTH during YEAR."
+;; (if (and (calendar-leap-year-p year) (= month 2))
+;; 29
+;; (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
+
+(defmacro calendar-day-number (date)
+ "Return the day number within the year of the date DATE.
+For example, (calendar-day-number '(1 1 1987)) returns the value 1,
+while (calendar-day-number '(12 31 1980)) returns 366."
+;;
+;; An explanation of the calculation can be found in PascAlgorithms by
+;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
+;;
+ (` (let* ((month (, (macroexpand (` (extract-calendar-month (, date))))))
+ (day (, (macroexpand (` (extract-calendar-day (, date))))))
+ (year (, (macroexpand (` (extract-calendar-year (, date))))))
+ (day-of-year (+ day (* 31 (1- month)))))
+ (if (> month 2)
+ (progn
+ (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
+ (if (, (macroexpand (` (calendar-leap-year-p year))))
+ (setq day-of-year (1+ day-of-year)))))
+ day-of-year)))
+;;(defun calendar-day-number (date)
+;; "Return the day number within the year of the date DATE.
+;;For example, (calendar-day-number '(1 1 1987)) returns the value 1,
+;;while (calendar-day-number '(12 31 1980)) returns 366."
+;; (let* ((month (extract-calendar-month date))
+;; (day (extract-calendar-day date))
+;; (year (extract-calendar-year date))
+;; (day-of-year (+ day (* 31 (1- month)))))
+;; (if (> month 2)
+;; (progn
+;; (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
+;; (if (calendar-leap-year-p year)
+;; (setq day-of-year (1+ day-of-year)))))
+;; day-of-year))
+
+(defmacro calendar-absolute-from-gregorian (date)
+ "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
+The Gregorian date Sunday, December 31, 1 BC is imaginary."
+ (` (let ((year (, (macroexpand (` (extract-calendar-year (, date)))))))
+ (+ (, (macroexpand (` (calendar-day-number (, date)))));; Days this year
+ (* 365 (1- year));; + Days in prior years
+ (/ (1- year) 4);; + Julian leap years
+ (- (/ (1- year) 100));; - century years
+ (/ (1- year) 400)))));; + Gregorian leap years
+;;(defun calendar-absolute-from-gregorian (date)
+;; "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
+;;The Gregorian date Sunday, December 31, 1 BC is imaginary."
+;; (let ((year (extract-calendar-year date)))
+;; (+ (calendar-day-number date);; Days this year
+;; (* 365 (1- year));; + Days in prior years
+;; (/ (1- year) 4);; + Julian leap years
+;; (- (/ (1- year) 100));; - century years
+;; (/ (1- year) 400))));; + Gregorian leap years