Mercurial > emacs

comparison lisp/calendar/calendar.el @ 93464:4d4a9542d49c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(increment-calendar-month): Optionally handle systems without 12 months per year.
author Glenn Morris <rgm@gnu.org>
date Mon, 31 Mar 2008 15:59:29 +0000
parents 64521597b7dd
children 2fe1b51b8771
comparison
equal deleted inserted replaced
93463:eb60699d02ea 93464:4d4a9542d49c
1211 "Name of the buffer used for the lunar phases.") 1211 "Name of the buffer used for the lunar phases.")
1212 1212
1213 (defconst cal-hebrew-yahrzeit-buffer "*Yahrzeits*" 1213 (defconst cal-hebrew-yahrzeit-buffer "*Yahrzeits*"
1214 "Name of the buffer used by `list-yahrzeit-dates'.") 1214 "Name of the buffer used by `list-yahrzeit-dates'.")
1215 1215
1216 (defmacro increment-calendar-month (mon yr n) 1216 (defmacro increment-calendar-month (mon yr n &optional nmonths)
1217 "Increment the variables MON and YR by N months. 1217 "Increment the variables MON and YR by N months.
1218 Forward if N is positive or backward if N is negative. 1218 Forward if N is positive or backward if N is negative.
1219 A negative YR is interpreted as BC; -1 being 1 BC, and so on. 1219 A negative YR is interpreted as BC; -1 being 1 BC, and so on.
1220 This is only appropriate for calendars with 12 months per year." 1220 Optional NMONTHS is the number of months per year (default 12)."
1221 `(let (macro-y) 1221 ;; Can view this as a form of base-nmonths arithmetic, in which "a
1222 ;; FIXME 12 could be an optional arg, if needed. 1222 ;; year" = "ten", and we never bother to use hundreds.
1223 `(let ((nmonths (or ,nmonths 12))
1224 macro-y)
1223 (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc 1225 (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc
1224 (setq macro-y (+ (* ,yr 12) ,mon -1 ,n) 1226 (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
1225 ,mon (1+ (mod macro-y 12)) 1227 ,mon (1+ (mod macro-y nmonths))
1226 ,yr (/ macro-y 12)) 1228 ,yr (/ macro-y nmonths))
1227 ;;; (setq macro-y (+ (* ,yr 12) ,mon -1 ,n) 1229 ;; Alternative:
1228 ;;; ,yr (/ macro-y 12) 1230 ;;; (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
1229 ;;; ,mon (- macro-y (* ,yr 12))) 1231 ;;; ,yr (/ macro-y nmonths)
1232 ;;; ,mon (- macro-y (* ,yr nmonths)))
1230 (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr))) 1233 (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
1231 (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc 1234 (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
1232 1235
1233 (defvar displayed-month) 1236 (defvar displayed-month)
1234 (defvar displayed-year) 1237 (defvar displayed-year)