From a8ee33abbf0b9b316564b3da638441958451a356 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 31 Mar 2008 16:00:05 +0000 Subject: [PATCH] (increment-calendar-month): Optionally handle systems without 12 months per year. --- lisp/ChangeLog | 4 +++- lisp/calendar/calendar.el | 23 +++++++++++++---------- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4ce645dbbaa..60992a89e43 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -49,7 +49,9 @@ * calendar/cal-julian.el (holiday-julian): Fix a problem with holidays in the last fortnight in Julian October. - * calendar/calendar.el (increment-calendar-month): Doc fix. + * calendar/calendar.el (increment-calendar-month): Optionally handle + systems without 12 months per year. + (calendar-date-is-visible-p): Doc fix. Simplify. * calendar/holidays.el (holiday-filter-visible-calendar): Return result diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index cd39f1ebbac..46f0bcd350a 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1213,20 +1213,23 @@ with descriptive strings such as (defconst cal-hebrew-yahrzeit-buffer "*Yahrzeits*" "Name of the buffer used by `list-yahrzeit-dates'.") -(defmacro increment-calendar-month (mon yr n) +(defmacro increment-calendar-month (mon yr n &optional nmonths) "Increment the variables MON and YR by N months. Forward if N is positive or backward if N is negative. A negative YR is interpreted as BC; -1 being 1 BC, and so on. -This is only appropriate for calendars with 12 months per year." - `(let (macro-y) - ;; FIXME 12 could be an optional arg, if needed. +Optional NMONTHS is the number of months per year (default 12)." + ;; Can view this as a form of base-nmonths arithmetic, in which "a + ;; year" = "ten", and we never bother to use hundreds. + `(let ((nmonths (or ,nmonths 12)) + macro-y) (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc - (setq macro-y (+ (* ,yr 12) ,mon -1 ,n) - ,mon (1+ (mod macro-y 12)) - ,yr (/ macro-y 12)) -;;; (setq macro-y (+ (* ,yr 12) ,mon -1 ,n) -;;; ,yr (/ macro-y 12) -;;; ,mon (- macro-y (* ,yr 12))) + (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n) + ,mon (1+ (mod macro-y nmonths)) + ,yr (/ macro-y nmonths)) + ;; Alternative: +;;; (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n) +;;; ,yr (/ macro-y nmonths) +;;; ,mon (- macro-y (* ,yr nmonths))) (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr))) (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc -- 2.39.5