From 71ea27eeaccebe2d1ca3d47610cb7c485a2a388d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 13 Mar 2008 06:29:28 +0000 Subject: [PATCH] Whitespace only. --- lisp/calendar/cal-bahai.el | 125 ++++----- lisp/calendar/cal-dst.el | 173 ++++++------ lisp/calendar/cal-french.el | 98 +++---- lisp/calendar/cal-hebrew.el | 444 +++++++++++++++---------------- lisp/calendar/cal-mayan.el | 80 +++--- lisp/calendar/cal-menu.el | 2 +- lisp/calendar/cal-move.el | 16 +- lisp/calendar/cal-tex.el | 2 +- lisp/calendar/cal-x.el | 10 +- lisp/calendar/calendar.el | 128 ++++----- lisp/calendar/diary-lib.el | 632 ++++++++++++++++++++++---------------------- lisp/calendar/lunar.el | 206 +++++++-------- 12 files changed, 961 insertions(+), 955 deletions(-) diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 3bb21e9bef5..911ee588dbb 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -77,36 +77,36 @@ The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let* ((month (extract-calendar-month date)) - (day (extract-calendar-day date)) - (year (extract-calendar-year date)) - (prior-years (+ (1- year) 1844)) - (leap-days (- (+ (/ prior-years 4) ; leap days in prior years - (- (/ prior-years 100)) - (/ prior-years 400)) - calendar-bahai-leap-base))) - (+ (1- calendar-bahai-epoch) ; days before epoch - (* 365 (1- year)) ; days in prior years + (day (extract-calendar-day date)) + (year (extract-calendar-year date)) + (prior-years (+ (1- year) 1844)) + (leap-days (- (+ (/ prior-years 4) ; leap days in prior years + (- (/ prior-years 100)) + (/ prior-years 400)) + calendar-bahai-leap-base))) + (+ (1- calendar-bahai-epoch) ; days before epoch + (* 365 (1- year)) ; days in prior years leap-days (calendar-sum m 1 (< m month) 19) (if (= month 19) 4 0) - day))) ; days so far this month + day))) ; days so far this month (defun calendar-bahai-from-absolute (date) "Bahá'í year corresponding to the absolute DATE." (if (< date calendar-bahai-epoch) (list 0 0 0) ; pre-Bahá'í date (let* ((greg (calendar-gregorian-from-absolute date)) - (year (+ (- (extract-calendar-year greg) 1844) - (if (or (> (extract-calendar-month greg) 3) - (and (= (extract-calendar-month greg) 3) - (>= (extract-calendar-day greg) 21))) - 1 0))) + (year (+ (- (extract-calendar-year greg) 1844) + (if (or (> (extract-calendar-month greg) 3) + (and (= (extract-calendar-month greg) 3) + (>= (extract-calendar-day greg) 21))) + 1 0))) (month ; search forward from Baha (1+ (calendar-sum m 1 - (> date - (calendar-absolute-from-bahai - (list m 19 year))) - 1))) + (> date + (calendar-absolute-from-bahai + (list m 19 year))) + 1))) (day ; calculate the day by subtraction (- date (1- (calendar-absolute-from-bahai (list month 1 year)))))) @@ -117,25 +117,25 @@ Gregorian date Sunday, December 31, 1 BC." "String of Bahá'í date of Gregorian DATE. Defaults to today's date if DATE is not given." (let* ((bahai-date (calendar-bahai-from-absolute - (calendar-absolute-from-gregorian - (or date (calendar-current-date))))) + (calendar-absolute-from-gregorian + (or date (calendar-current-date))))) (y (extract-calendar-year bahai-date)) (m (extract-calendar-month bahai-date)) (d (extract-calendar-day bahai-date))) (let ((monthname - (if (and (= m 19) - (<= d 0)) - "Ayyám-i-Há" - (aref calendar-bahai-month-name-array (1- m)))) - (day (int-to-string - (if (<= d 0) - (if (calendar-bahai-leap-year-p y) - (+ d 5) - (+ d 4)) - d))) - (dayname nil) - (month (int-to-string m)) - (year (int-to-string y))) + (if (and (= m 19) + (<= d 0)) + "Ayyám-i-Há" + (aref calendar-bahai-month-name-array (1- m)))) + (day (int-to-string + (if (<= d 0) + (if (calendar-bahai-leap-year-p y) + (+ d 5) + (+ d 4)) + d))) + (dayname nil) + (month (int-to-string m)) + (year (int-to-string y))) (mapconcat 'eval calendar-date-display-form "")))) ;;;###cal-autoload @@ -166,15 +166,15 @@ Echo Bahá'í date unless NOECHO is t." (calendar-absolute-from-gregorian today)))))) (completion-ignore-case t) (month (cdr (assoc - (completing-read - "Bahá'í calendar month name: " - (mapcar 'list - (append calendar-bahai-month-name-array nil)) - nil t) + (completing-read + "Bahá'í calendar month name: " + (mapcar 'list + (append calendar-bahai-month-name-array nil)) + nil t) (calendar-make-alist calendar-bahai-month-name-array 1)))) (day (calendar-read "Bahá'í calendar day (1-19): " - (lambda (x) (and (< 0 x) (<= x 19)))))) + (lambda (x) (and (< 0 x) (<= x 19)))))) (list (list month day year)))) (defvar displayed-month) @@ -187,15 +187,15 @@ If MONTH, DAY (Bahá'í) is visible, the value returned is corresponding Gregorian date in the form of the list (((month day year) STRING)). Returns nil if it is not visible in the current calendar window." (let* ((bahai-date (calendar-bahai-from-absolute - (calendar-absolute-from-gregorian - (list displayed-month 15 displayed-year)))) + (calendar-absolute-from-gregorian + (list displayed-month 15 displayed-year)))) (m (extract-calendar-month bahai-date)) (y (extract-calendar-year bahai-date)) - (date)) + (date)) (if (< m 1) - nil ; Bahá'í calendar doesn't apply + nil ; Bahá'í calendar doesn't apply (increment-calendar-month m y (- 10 month)) - (if (> m 7) ; Bahá'í date might be visible + (if (> m 7) ; Bahá'í date might be visible (let ((date (calendar-gregorian-from-absolute (calendar-absolute-from-bahai (list month day y))))) (if (calendar-date-is-visible-p date) @@ -406,7 +406,7 @@ part of `nongregorian-diary-marking-hook'." (cdr (assoc-string mm-name (calendar-make-alist - calendar-bahai-month-name-array) + calendar-bahai-month-name-array) t))))) (calendar-bahai-mark-date-pattern mm dd yy))))) (setq d (cdr d))))) @@ -427,15 +427,15 @@ A value of 0 in any position is a wildcard." (mark-visible-calendar-date date))) ;; Month and day in any year--this taken from the holiday stuff. (let* ((bahai-date (calendar-bahai-from-absolute - (calendar-absolute-from-gregorian - (list displayed-month 15 displayed-year)))) + (calendar-absolute-from-gregorian + (list displayed-month 15 displayed-year)))) (m (extract-calendar-month bahai-date)) (y (extract-calendar-year bahai-date)) (date)) (if (< m 1) - nil ; Bahá'í calendar doesn't apply + nil ; Bahá'í calendar doesn't apply (increment-calendar-month m y (- 10 month)) - (if (> m 7) ; Bahá'í date might be visible + (if (> m 7) ; Bahá'í date might be visible (let ((date (calendar-gregorian-from-absolute (calendar-absolute-from-bahai (list month day y))))) @@ -457,18 +457,19 @@ A value of 0 in any position is a wildcard." (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* ((b-date (calendar-bahai-from-absolute date)) - (i-month (extract-calendar-month b-date)) - (i-day (extract-calendar-day b-date)) - (i-year (extract-calendar-year b-date))) - (and (or (zerop month) - (= month i-month)) - (or (zerop day) - (= day i-day)) - (or (zerop year) - (= year i-year)) - (mark-visible-calendar-date - (calendar-gregorian-from-absolute date))))))))) + (let* ((b-date (calendar-bahai-from-absolute date)) + (i-month (extract-calendar-month b-date)) + (i-day (extract-calendar-day b-date)) + (i-year (extract-calendar-year b-date))) + (and (or (zerop month) + (= month i-month)) + (or (zerop day) + (= day i-day)) + (or (zerop year) + (= year i-year)) + (mark-visible-calendar-date + (calendar-gregorian-from-absolute + date))))))))) ;;;###cal-autoload (defun diary-bahai-insert-entry (arg) diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index b35ec29deb0..78d8b7f4793 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -4,7 +4,7 @@ ;; 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Paul Eggert -;; Edward M. Reingold +;; Edward M. Reingold ;; Maintainer: Glenn Morris ;; Keywords: calendar ;; Human-Keywords: daylight saving time, calendar, diary, holidays @@ -113,15 +113,15 @@ high and low 16 bits, respectively, of the number of seconds since Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on absolute date ABS-DATE is the equivalent moment to X." (let* ((h (car x)) - (xtail (cdr x)) + (xtail (cdr x)) (l (+ utc-diff (if (numberp xtail) xtail (car xtail)))) (u (+ (* 512 (mod h 675)) (floor l 128)))) ;; Overflow is a terrible thing! (cons (+ calendar-system-time-basis - ;; floor((2^16 h +l) / (60*60*24)) - (* 512 (floor h 675)) (floor u 675)) - ;; (2^16 h +l) mod (60*60*24) - (+ (* (mod u 675) 128) (mod l 128))))) + ;; floor((2^16 h +l) / (60*60*24)) + (* 512 (floor h 675)) (floor u 675)) + ;; (2^16 h +l) mod (60*60*24) + (+ (* (mod u 675) 128) (mod l 128))))) (defun calendar-time-from-absolute (abs-date s) "Time of absolute date ABS-DATE, S seconds after midnight. @@ -143,12 +143,12 @@ midnight UTC on absolute date ABS-DATE." "Return the time of the next time zone transition after TIME. Both TIME and the result are acceptable arguments to `current-time-zone'. Return nil if no such transition can be found." - (let* ((base 65536);; 2^16 = base of current-time output - (quarter-multiple 120);; approx = (seconds per quarter year) / base - (time-zone (current-time-zone time)) - (time-utc-diff (car time-zone)) + (let* ((base 65536) ;; 2^16 = base of current-time output + (quarter-multiple 120) ;; approx = (seconds per quarter year) / base + (time-zone (current-time-zone time)) + (time-utc-diff (car time-zone)) hi - hi-zone + hi-zone (hi-utc-diff time-utc-diff) (quarters '(2 1 3))) ;; Heuristic: probe the time zone offset in the next three calendar @@ -166,21 +166,21 @@ Return nil if no such transition can be found." ;; Set LO to TIME, and then binary search to increase LO and decrease HI ;; until LO is just before and HI is just after the time zone transition. (let* ((tail (cdr time)) - (lo (cons (car time) (if (numberp tail) tail (car tail)))) - probe) + (lo (cons (car time) (if (numberp tail) tail (car tail)))) + probe) (while - ;; Set PROBE to halfway between LO and HI, rounding down. - ;; If PROBE equals LO, we are done. - (let* ((lsum (+ (cdr lo) (cdr hi))) - (hsum (+ (car lo) (car hi) (/ lsum base))) - (hsumodd (logand 1 hsum))) - (setq probe (cons (/ (- hsum hsumodd) 2) - (/ (+ (* hsumodd base) (% lsum base)) 2))) - (not (equal lo probe))) - ;; Set either LO or HI to PROBE, depending on probe results. - (if (eq (car (current-time-zone probe)) hi-utc-diff) - (setq hi probe) - (setq lo probe))) + ;; Set PROBE to halfway between LO and HI, rounding down. + ;; If PROBE equals LO, we are done. + (let* ((lsum (+ (cdr lo) (cdr hi))) + (hsum (+ (car lo) (car hi) (/ lsum base))) + (hsumodd (logand 1 hsum))) + (setq probe (cons (/ (- hsum hsumodd) 2) + (/ (+ (* hsumodd base) (% lsum base)) 2))) + (not (equal lo probe))) + ;; Set either LO or HI to PROBE, depending on probe results. + (if (eq (car (current-time-zone probe)) hi-utc-diff) + (setq hi probe) + (setq lo probe))) hi)))) (defun calendar-time-zone-daylight-rules (abs-date utc-diff) @@ -188,69 +188,70 @@ Return nil if no such transition can be found." ABS-DATE must specify a day that contains a daylight saving transition. The result has the proper form for `calendar-daylight-savings-starts'." (let* ((date (calendar-gregorian-from-absolute abs-date)) - (weekday (% abs-date 7)) - (m (extract-calendar-month date)) - (d (extract-calendar-day date)) - (y (extract-calendar-year date)) + (weekday (% abs-date 7)) + (m (extract-calendar-month date)) + (d (extract-calendar-day date)) + (y (extract-calendar-year date)) (last (calendar-last-day-of-month m y)) - (candidate-rules - (append - ;; Day D of month M. - (list (list 'list m d 'year)) - ;; The first WEEKDAY of month M. + (candidate-rules + (append + ;; Day D of month M. + (list (list 'list m d 'year)) + ;; The first WEEKDAY of month M. (if (< d 8) (list (list 'calendar-nth-named-day 1 weekday m 'year))) - ;; The last WEEKDAY of month M. + ;; The last WEEKDAY of month M. (if (> d (- last 7)) (list (list 'calendar-nth-named-day -1 weekday m 'year))) - ;; The first WEEKDAY after day J of month M, for D-6 < J <= D. + ;; The first WEEKDAY after day J of month M, for D-6 < J <= D. (let (l) (calendar-for-loop j from (max 2 (- d 6)) to (min d (- last 8)) do - (setq l - (cons - (list 'calendar-nth-named-day 1 weekday m 'year j) - l))) - l) - ;; 01-01 and 07-01 for this year's Persian calendar. - (if (and (= m 3) (<= 20 d) (<= d 21)) - '((calendar-gregorian-from-absolute - (calendar-absolute-from-persian - (list 1 1 (- year 621)))))) - (if (and (= m 9) (<= 22 d) (<= d 23)) - '((calendar-gregorian-from-absolute - (calendar-absolute-from-persian - (list 7 1 (- year 621)))))))) - (prevday-sec (- -1 utc-diff)) ;; last sec of previous local day - (year (1+ y))) + (setq l + (cons + (list 'calendar-nth-named-day + 1 weekday m 'year j) + l))) + l) + ;; 01-01 and 07-01 for this year's Persian calendar. + (if (and (= m 3) (<= 20 d) (<= d 21)) + '((calendar-gregorian-from-absolute + (calendar-absolute-from-persian + (list 1 1 (- year 621)))))) + (if (and (= m 9) (<= 22 d) (<= d 23)) + '((calendar-gregorian-from-absolute + (calendar-absolute-from-persian + (list 7 1 (- year 621)))))))) + (prevday-sec (- -1 utc-diff)) ;; last sec of previous local day + (year (1+ y))) ;; Scan through the next few years until only one rule remains. (while - (let ((rules candidate-rules) - new-rules) - (while - (let* - ((rule (car rules)) - (date - ;; The following is much faster than - ;; (calendar-absolute-from-gregorian (eval rule)). - (cond ((eq (car rule) 'calendar-nth-named-day) - (eval (cons 'calendar-nth-named-absday (cdr rule)))) - ((eq (car rule) 'calendar-gregorian-from-absolute) - (eval (car (cdr rule)))) - (t (let ((g (eval rule))) - (calendar-absolute-from-gregorian g)))))) - (or (equal - (current-time-zone - (calendar-time-from-absolute date prevday-sec)) - (current-time-zone - (calendar-time-from-absolute (1+ date) prevday-sec))) - (setq new-rules (cons rule new-rules))) - (setq rules (cdr rules)))) - ;; If no rules remain, just use the first candidate rule; - ;; it's wrong in general, but it's right for at least one year. - (setq candidate-rules (if new-rules (nreverse new-rules) - (list (car candidate-rules)))) - (setq year (1+ year)) - (cdr candidate-rules))) + (let ((rules candidate-rules) + new-rules) + (while + (let* + ((rule (car rules)) + (date + ;; The following is much faster than + ;; (calendar-absolute-from-gregorian (eval rule)). + (cond ((eq (car rule) 'calendar-nth-named-day) + (eval (cons 'calendar-nth-named-absday (cdr rule)))) + ((eq (car rule) 'calendar-gregorian-from-absolute) + (eval (car (cdr rule)))) + (t (let ((g (eval rule))) + (calendar-absolute-from-gregorian g)))))) + (or (equal + (current-time-zone + (calendar-time-from-absolute date prevday-sec)) + (current-time-zone + (calendar-time-from-absolute (1+ date) prevday-sec))) + (setq new-rules (cons rule new-rules))) + (setq rules (cdr rules)))) + ;; If no rules remain, just use the first candidate rule; + ;; it's wrong in general, but it's right for at least one year. + (setq candidate-rules (if new-rules (nreverse new-rules) + (list (car candidate-rules)))) + (setq year (1+ year)) + (cdr candidate-rules))) (car candidate-rules))) ;; TODO it might be better to extract this information directly from @@ -414,7 +415,7 @@ This function respects the value of `calendar-dst-check-each-year-flag'." (cadr (calendar-dst-find-startend year)) (nth 4 calendar-current-time-zone-cache)))) (if expr (eval expr))) - ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. + ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. (and (not (zerop calendar-daylight-time-offset)) (calendar-nth-named-day 2 0 3 year)))) @@ -425,7 +426,7 @@ This function respects the value of `calendar-dst-check-each-year-flag'." (nth 2 (calendar-dst-find-startend year)) (nth 5 calendar-current-time-zone-cache)))) (if expr (eval expr))) - ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. + ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. (and (not (zerop calendar-daylight-time-offset)) (calendar-nth-named-day 1 0 11 year)))) @@ -469,12 +470,12 @@ Conversion to daylight saving time is done according to `calendar-daylight-savings-offset'." (let* ((rounded-abs-date (+ (calendar-absolute-from-gregorian date) - (/ (round (* 60 time)) 60.0 24.0))) + (/ (round (* 60 time)) 60.0 24.0))) (dst (dst-in-effect rounded-abs-date)) - (time-zone (if dst - calendar-daylight-time-zone-name - calendar-standard-time-zone-name)) - (time (+ rounded-abs-date + (time-zone (if dst + calendar-daylight-time-zone-name + calendar-standard-time-zone-name)) + (time (+ rounded-abs-date (if dst (/ calendar-daylight-time-offset 24.0 60.0) 0)))) (list (calendar-gregorian-from-absolute (truncate time)) (* 24.0 (- time (truncate time))) diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index 1284370809f..1a6057b9b93 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -44,10 +44,10 @@ (defun french-calendar-accents () "True if diacritical marks are available." (and (or window-system - (terminal-coding-system)) + (terminal-coding-system)) (or enable-multibyte-characters - (and (char-table-p standard-display-table) - (equal (aref standard-display-table 161) [161]))))) + (and (char-table-p standard-display-table) + (equal (aref standard-display-table 161) [161]))))) (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) "Absolute date of start of French Revolutionary calendar = September 22, 1792.") @@ -145,20 +145,22 @@ The absolute date is the number of days elapsed since the (year ; search forward from the approximation (+ approx (calendar-sum y approx - (>= date (calendar-absolute-from-french (list 1 1 (1+ y)))) - 1))) + (>= date (calendar-absolute-from-french + (list 1 1 (1+ y)))) + 1))) (month ; search forward from Vendemiaire (1+ (calendar-sum m 1 - (> date - (calendar-absolute-from-french - (list m - (french-calendar-last-day-of-month m year) - year))) - 1))) + (> date + (calendar-absolute-from-french + (list m + (french-calendar-last-day-of-month + m year) + year))) + 1))) (day ; calculate the day by subtraction (- date (1- (calendar-absolute-from-french (list month 1 year)))))) - (list month day year)))) + (list month day year)))) ;;;###cal-autoload (defun calendar-french-date-string (&optional date) @@ -201,47 +203,47 @@ Defaults to today's date if DATE is not given." Echo French Revolutionary date unless NOECHO is t." (interactive (let ((accents (french-calendar-accents)) - (months (french-calendar-month-name-array)) - (special-days (french-calendar-special-days-array))) + (months (french-calendar-month-name-array)) + (special-days (french-calendar-special-days-array))) (let* ((year - (progn - (calendar-read - (if accents - "Année de la Révolution (>0): " - "Anne'e de la Re'volution (>0): ") - (lambda (x) (> x 0)) - (int-to-string - (extract-calendar-year - (calendar-french-from-absolute - (calendar-absolute-from-gregorian - (calendar-current-date)))))))) - (month-list - (mapcar 'list - (append months - (if (french-calendar-leap-year-p year) - (mapcar - (lambda (x) (concat "Jour " x)) - french-calendar-special-days-array) - (reverse - (cdr ; we don't want rev. day in a non-leap yr - (reverse - (mapcar - (lambda (x) - (concat "Jour " x)) - special-days)))))))) - (completion-ignore-case t) - (month (cdr (assoc-string + (progn + (calendar-read + (if accents + "Année de la Révolution (>0): " + "Anne'e de la Re'volution (>0): ") + (lambda (x) (> x 0)) + (int-to-string + (extract-calendar-year + (calendar-french-from-absolute + (calendar-absolute-from-gregorian + (calendar-current-date)))))))) + (month-list + (mapcar 'list + (append months + (if (french-calendar-leap-year-p year) + (mapcar + (lambda (x) (concat "Jour " x)) + french-calendar-special-days-array) + (reverse + (cdr ; we don't want rev. day in a non-leap yr + (reverse + (mapcar + (lambda (x) + (concat "Jour " x)) + special-days)))))))) + (completion-ignore-case t) + (month (cdr (assoc-string (completing-read "Mois ou Sansculottide: " month-list nil t) - (calendar-make-alist month-list 1 'car) t))) - (day (if (> month 12) - (- month 12) - (calendar-read - "Jour (1-30): " - (lambda (x) (and (<= 1 x) (<= x 30)))))) - (month (if (> month 12) 13 month))) + (calendar-make-alist month-list 1 'car) t))) + (day (if (> month 12) + (- month 12) + (calendar-read + "Jour (1-30): " + (lambda (x) (and (<= 1 x) (<= x 30)))))) + (month (if (> month 12) 13 month))) (list (list month day year))))) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-french date))) diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 1e68cc6b7d2..c4d2ac67f0b 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -64,27 +64,27 @@ (* 12 months-elapsed) (* 793 (/ months-elapsed 1080)) (/ parts-elapsed 1080))) - (parts ; conjunction parts + (parts ; conjunction parts (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080))) - (day ; conjunction day + (day ; conjunction day (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24))) (alternative-day (if (or (>= parts 19440) ; if the new moon is at or after midday - (and (= (% day 7) 2) ; ...or is on a Tuesday... + (and (= (% day 7) 2) ; ...or is on a Tuesday... (>= parts 9924) ; at 9 hours, 204 parts or later... - ;; of a common year... + ;; of a common year... (not (hebrew-calendar-leap-year-p year))) - (and (= (% day 7) 1) ; ...or is on a Monday... + (and (= (% day 7) 1) ; ...or is on a Monday... (>= parts 16789) ; at 15 hours, 589 parts or later... - ;; at the end of a leap year. + ;; at the end of a leap year. (hebrew-calendar-leap-year-p (1- year)))) - ;; Then postpone Rosh HaShanah one day. + ;; Then postpone Rosh HaShanah one day. (1+ day) - ;; Else: + ;; Else: day))) ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday (if (memq (% alternative-day 7) (list 0 3 5)) - ;; Then postpone it one (more) day and return. + ;; Then postpone it one (more) day and return. (1+ alternative-day) ;; Else return. alternative-day))) @@ -118,21 +118,21 @@ Gregorian date Sunday, December 31, 1 BC." (let* ((month (extract-calendar-month date)) (day (extract-calendar-day date)) (year (extract-calendar-year date))) - (+ day ; days so far this month - (if (< month 7) ; before Tishri - ;; Then add days in prior months this year before and after Nisan. + (+ day ; days so far this month + (if (< month 7) ; before Tishri + ;; Then add days in prior months this year before and after Nisan. (+ (calendar-sum m 7 (<= m (hebrew-calendar-last-month-of-year year)) (hebrew-calendar-last-day-of-month m year)) (calendar-sum m 1 (< m month) (hebrew-calendar-last-day-of-month m year))) - ;; Else add days in prior months this year. + ;; Else add days in prior months this year. (calendar-sum m 7 (< m month) (hebrew-calendar-last-day-of-month m year))) - (hebrew-calendar-elapsed-days year) ; days in prior years - -1373429))) ; days elapsed before absolute date 1 + (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. @@ -140,11 +140,11 @@ 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)))) + (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))) + (setq year (1+ year))) (let ((length (hebrew-calendar-last-month-of-year year))) (while (> date (calendar-absolute-from-hebrew @@ -159,12 +159,12 @@ Gregorian date Sunday, December 31, 1 BC." (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.") + "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.") + "Array of strings giving the names of the Hebrew months in a leap year.") ;;;###cal-autoload (defun calendar-hebrew-date-string (&optional date) @@ -242,17 +242,17 @@ Driven by the variable `calendar-date-display-form'." (mapcar 'list (append month-array nil)) (if (= year 3761) (lambda (x) - (let ((m (cdr - (assoc-string - (car x) - (calendar-make-alist month-array) - t)))) - (< 0 - (calendar-absolute-from-hebrew - (list m - (hebrew-calendar-last-day-of-month - m year) - year)))))) + (let ((m (cdr + (assoc-string + (car x) + (calendar-make-alist month-array) + t)))) + (< 0 + (calendar-absolute-from-hebrew + (list m + (hebrew-calendar-last-day-of-month + m year) + year)))))) t) (calendar-make-alist month-array 1) t))) (last (hebrew-calendar-last-day-of-month month year)) @@ -311,21 +311,21 @@ nil if it is not visible in the current calendar window." "List of dates related to Rosh Hashanah, as visible in calendar window." (if (or (< displayed-month 8) (> displayed-month 11)) - nil ; none of the dates is visible + nil ; none of the dates is visible (let* ((abs-r-h (calendar-absolute-from-hebrew - (list 7 1 (+ displayed-year 3761)))) - (mandatory - (list - (list (calendar-gregorian-from-absolute abs-r-h) - (format "Rosh HaShanah %d" (+ 3761 displayed-year))) - (list (calendar-gregorian-from-absolute (+ abs-r-h 9)) - "Yom Kippur") - (list (calendar-gregorian-from-absolute (+ abs-r-h 14)) - "Sukkot") - (list (calendar-gregorian-from-absolute (+ abs-r-h 21)) - "Shemini Atzeret") - (list (calendar-gregorian-from-absolute (+ abs-r-h 22)) - "Simchat Torah"))) + (list 7 1 (+ displayed-year 3761)))) + (mandatory + (list + (list (calendar-gregorian-from-absolute abs-r-h) + (format "Rosh HaShanah %d" (+ 3761 displayed-year))) + (list (calendar-gregorian-from-absolute (+ abs-r-h 9)) + "Yom Kippur") + (list (calendar-gregorian-from-absolute (+ abs-r-h 14)) + "Sukkot") + (list (calendar-gregorian-from-absolute (+ abs-r-h 21)) + "Shemini Atzeret") + (list (calendar-gregorian-from-absolute (+ abs-r-h 22)) + "Simchat Torah"))) (optional (list (list (calendar-gregorian-from-absolute @@ -357,8 +357,8 @@ nil if it is not visible in the current calendar window." "Hol Hamoed Sukkot (fourth day)") (list (calendar-gregorian-from-absolute (+ abs-r-h 20)) "Hoshanah Rabbah"))) - (output-list - (holiday-filter-visible-calendar mandatory))) + (output-list + (holiday-filter-visible-calendar mandatory))) (if all-hebrew-calendar-holidays (setq output-list (append @@ -371,43 +371,43 @@ nil if it is not visible in the current calendar window." "List of dates related to Hanukkah, as visible in calendar window." ;; This test is only to speed things up a bit, it works fine without it. (if (memq displayed-month - '(10 11 12 1 2)) + '(10 11 12 1 2)) (let ((m displayed-month) - (y displayed-year)) - (increment-calendar-month m y 1) - (let* ((h-y (extract-calendar-year - (calendar-hebrew-from-absolute - (calendar-absolute-from-gregorian - (list m (calendar-last-day-of-month m y) y))))) - (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) - (holiday-filter-visible-calendar - (list - (list (calendar-gregorian-from-absolute (1- abs-h)) - "Erev Hanukkah") - (list (calendar-gregorian-from-absolute abs-h) - "Hanukkah (first day)") - (list (calendar-gregorian-from-absolute (1+ abs-h)) - "Hanukkah (second day)") - (list (calendar-gregorian-from-absolute (+ abs-h 2)) - "Hanukkah (third day)") - (list (calendar-gregorian-from-absolute (+ abs-h 3)) - "Hanukkah (fourth day)") - (list (calendar-gregorian-from-absolute (+ abs-h 4)) - "Hanukkah (fifth day)") - (list (calendar-gregorian-from-absolute (+ abs-h 5)) - "Hanukkah (sixth day)") - (list (calendar-gregorian-from-absolute (+ abs-h 6)) - "Hanukkah (seventh day)") - (list (calendar-gregorian-from-absolute (+ abs-h 7)) - "Hanukkah (eighth day)"))))))) + (y displayed-year)) + (increment-calendar-month m y 1) + (let* ((h-y (extract-calendar-year + (calendar-hebrew-from-absolute + (calendar-absolute-from-gregorian + (list m (calendar-last-day-of-month m y) y))))) + (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) + (holiday-filter-visible-calendar + (list + (list (calendar-gregorian-from-absolute (1- abs-h)) + "Erev Hanukkah") + (list (calendar-gregorian-from-absolute abs-h) + "Hanukkah (first day)") + (list (calendar-gregorian-from-absolute (1+ abs-h)) + "Hanukkah (second day)") + (list (calendar-gregorian-from-absolute (+ abs-h 2)) + "Hanukkah (third day)") + (list (calendar-gregorian-from-absolute (+ abs-h 3)) + "Hanukkah (fourth day)") + (list (calendar-gregorian-from-absolute (+ abs-h 4)) + "Hanukkah (fifth day)") + (list (calendar-gregorian-from-absolute (+ abs-h 5)) + "Hanukkah (sixth day)") + (list (calendar-gregorian-from-absolute (+ abs-h 6)) + "Hanukkah (seventh day)") + (list (calendar-gregorian-from-absolute (+ abs-h 7)) + "Hanukkah (eighth day)"))))))) ;;;###holiday-autoload (defun holiday-passover-etc () "List of dates related to Passover, as visible in calendar window." - (if (< 7 displayed-month) - nil ; none of the dates is visible + (if (< 7 displayed-month) + nil ; none of the dates is visible (let* ((abs-p (calendar-absolute-from-hebrew - (list 1 15 (+ displayed-year 3760)))) + (list 1 15 (+ displayed-year 3760)))) (mandatory (list (list (calendar-gregorian-from-absolute abs-p) @@ -478,7 +478,7 @@ nil if it is not visible in the current calendar window." (list (calendar-gregorian-from-absolute (+ abs-p 51)) "Shavuot (second day)"))) (output-list - (holiday-filter-visible-calendar mandatory))) + (holiday-filter-visible-calendar mandatory))) (if all-hebrew-calendar-holidays (setq output-list (append @@ -491,9 +491,9 @@ nil if it is not visible in the current calendar window." "List of dates around Tisha B'Av, as visible in calendar window." (if (or (< displayed-month 5) (> displayed-month 9)) - nil ; none of the dates is visible + nil ; none of the dates is visible (let* ((abs-t-a (calendar-absolute-from-hebrew - (list 5 9 (+ displayed-year 3760))))) + (list 5 9 (+ displayed-year 3760))))) (holiday-filter-visible-calendar (list @@ -514,7 +514,7 @@ nil if it is not visible in the current calendar window." (declare-function add-to-diary-list "diary-lib" (date string specifier &optional marker globcolor literal)) -(defvar number) ; from diary-list-entries +(defvar number) ; from diary-list-entries ;;;###diary-autoload (defun list-hebrew-diary-entries () @@ -619,8 +619,8 @@ A value of 0 in any position is a wildcard." (if (calendar-date-is-visible-p date) (mark-visible-calendar-date date))) ;; Month and day in any year--this taken from the holiday stuff. - ;; This test is only to speed things up a bit, it works - ;; fine without it. + ;; This test is only to speed things up a bit, it works + ;; fine without it. (if (memq displayed-month (list (if (< 11 month) (- month 11) (+ month 1)) @@ -668,18 +668,19 @@ A value of 0 in any position is a wildcard." (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))))))))) + (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))))) + )))) (declare-function diary-name-pattern "diary-lib" (string-array &optional abbrev-array paren)) @@ -704,7 +705,7 @@ is provided for use as part of `nongregorian-diary-marking-hook'." (let* ((date-form (if (equal (car (car d)) 'backup) (cdr (car d)) - (car d))) ; ignore 'backup directive + (car d))) ; ignore 'backup directive (dayname (diary-name-pattern calendar-day-name-array calendar-day-abbrev-array)) (monthname @@ -781,9 +782,9 @@ is provided for use as part of `nongregorian-diary-marking-hook'." (if dd-name (mark-calendar-days-named (cdr (assoc-string dd-name - (calendar-make-alist - calendar-day-name-array - 0 nil calendar-day-abbrev-array) t))) + (calendar-make-alist + calendar-day-name-array + 0 nil calendar-day-abbrev-array) t))) (if mm-name (setq mm (if (string-equal mm-name "*") 0 @@ -889,8 +890,8 @@ from the cursor position." (end-year (calendar-read (format "Ending year of Yahrzeit table (>=%d): " start-year) - (lambda (x) (>= x start-year))))) - (list death-date start-year end-year))) + (lambda (x) (>= x start-year))))) + (list death-date start-year end-year))) (message "Computing Yahrzeits...") (let* ((h-date (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian death-date))) @@ -910,14 +911,15 @@ from the cursor position." (erase-buffer) (goto-char (point-min)) (calendar-for-loop i from start-year to end-year do - (insert - (calendar-date-string - (calendar-gregorian-from-absolute - (hebrew-calendar-yahrzeit - h-date - (extract-calendar-year - (calendar-hebrew-from-absolute - (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n")) + (insert + (calendar-date-string + (calendar-gregorian-from-absolute + (hebrew-calendar-yahrzeit + h-date + (extract-calendar-year + (calendar-hebrew-from-absolute + (calendar-absolute-from-gregorian + (list 1 1 i))))))) "\n")) (goto-char (point-min)) (set-buffer-modified-p nil) (setq buffer-read-only t) @@ -947,17 +949,17 @@ use when highlighting the day in the calendar." (day (% omer 7))) (if (and (> omer 0) (< omer 50)) (cons mark - (format "Day %d%s of the omer (until sunset)" - omer - (if (zerop week) - "" - (format ", that is, %d week%s%s" - week - (if (= week 1) "" "s") - (if (zerop day) - "" - (format " and %d day%s" - day (if (= day 1) "" "s")))))))))) + (format "Day %d%s of the omer (until sunset)" + omer + (if (zerop week) + "" + (format ", that is, %d week%s%s" + week + (if (= week 1) "" "s") + (if (zerop day) + "" + (format " and %d day%s" + day (if (= day 1) "" "s")))))))))) (defvar entry) @@ -976,7 +978,7 @@ use when highlighting the day in the calendar." (calendar-absolute-from-gregorian (if european-calendar-style (list death-day death-month death-year) - (list death-month death-day death-year))))) + (list death-month death-day death-year))))) (h-month (extract-calendar-month h-date)) (h-day (extract-calendar-day h-date)) (h-year (extract-calendar-year h-date)) @@ -986,14 +988,14 @@ use when highlighting the day in the calendar." (y (hebrew-calendar-yahrzeit h-date yr))) (if (and (> diff 0) (or (= y d) (= y (1+ d)))) (cons mark - (format "Yahrzeit of %s%s: %d%s anniversary" - entry - (if (= y d) "" " (evening)") - diff - (cond ((= (% diff 10) 1) "st") - ((= (% diff 10) 2) "nd") - ((= (% diff 10) 3) "rd") - (t "th"))))))) + (format "Yahrzeit of %s%s: %d%s anniversary" + entry + (if (= y d) "" " (evening)") + diff + (cond ((= (% diff 10) 1) "st") + ((= (% diff 10) 2) "nd") + ((= (% diff 10) 3) "rd") + (t "th"))))))) ;;;###diary-autoload (defun diary-rosh-hodesh (&optional mark) @@ -1018,60 +1020,60 @@ use when highlighting the day in the calendar." (calendar-hebrew-from-absolute (1- d))))) (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7))) (cons mark - (format - "Rosh Hodesh %s" - (if (= h-day 30) - (format - "%s (first day)" - ;; Next month must be in the same year since this - ;; month can't be the last month of the year since - ;; it has 30 days - (aref h-month-names h-month)) - (if (= h-yesterday 30) - (format "%s (second day)" this-month) - this-month)))) - (if (= (% d 7) 6) ; Saturday--check for Shabbat Mevarchim + (format + "Rosh Hodesh %s" + (if (= h-day 30) + (format + "%s (first day)" + ;; Next month must be in the same year since this + ;; month can't be the last month of the year since + ;; it has 30 days + (aref h-month-names h-month)) + (if (= h-yesterday 30) + (format "%s (second day)" this-month) + this-month)))) + (if (= (% d 7) 6) ; Saturday--check for Shabbat Mevarchim (cons mark - (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day)) - (format "Mevarchim Rosh Hodesh %s (%s)" - (aref h-month-names - (if (= h-month - (hebrew-calendar-last-month-of-year - h-year)) - 0 h-month)) - (aref calendar-day-name-array (- 29 h-day)))) - ((and (< h-day 30) (> h-day 22) (= 30 last-day)) - (format "Mevarchim Rosh Hodesh %s (%s-%s)" - (aref h-month-names h-month) - (if (= h-day 29) - "tomorrow" - (aref calendar-day-name-array (- 29 h-day))) - (aref calendar-day-name-array - (% (- 30 h-day) 7)))))) + (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day)) + (format "Mevarchim Rosh Hodesh %s (%s)" + (aref h-month-names + (if (= h-month + (hebrew-calendar-last-month-of-year + h-year)) + 0 h-month)) + (aref calendar-day-name-array (- 29 h-day)))) + ((and (< h-day 30) (> h-day 22) (= 30 last-day)) + (format "Mevarchim Rosh Hodesh %s (%s-%s)" + (aref h-month-names h-month) + (if (= h-day 29) + "tomorrow" + (aref calendar-day-name-array (- 29 h-day))) + (aref calendar-day-name-array + (% (- 30 h-day) 7)))))) (if (and (= h-day 29) (/= h-month 6)) (cons mark - (format "Erev Rosh Hodesh %s" - (aref h-month-names - (if (= h-month - (hebrew-calendar-last-month-of-year - h-year)) - 0 h-month))))))))) + (format "Erev Rosh Hodesh %s" + (aref h-month-names + (if (= h-month + (hebrew-calendar-last-month-of-year + 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"] + ["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 + (if (arrayp p) ; combined parasha (format "%s/%s" (aref hebrew-calendar-parashiot-names (aref p 0)) (aref hebrew-calendar-parashiot-names (aref p 1))) @@ -1083,7 +1085,7 @@ use when highlighting the day in the calendar." An optional parameter MARK specifies a face or single-character string to use when highlighting the day in the calendar." (let ((d (calendar-absolute-from-gregorian date))) - (if (= (% d 7) 6) ; Saturday + (if (= (% d 7) 6) ; Saturday (let* ((h-year (extract-calendar-year (calendar-hebrew-from-absolute d))) @@ -1104,81 +1106,81 @@ use when highlighting the day in the calendar." (symbol-value (intern (format "hebrew-calendar-year-%s-%s-%s" ; keviah rosh-hashanah-day type passover-day)))) - (first-saturday ; of Hebrew year + (first-saturday ; of Hebrew year (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah))) - (saturday ; which Saturday of the Hebrew year + (saturday ; which Saturday of the Hebrew year (/ (- d first-saturday) 7)) (parasha (aref year-format saturday))) (if parasha (cons mark - (format - "Parashat %s" - (if (listp parasha) ; Israel differs from diaspora - (if (car parasha) - (format "%s (diaspora), %s (Israel)" - (hebrew-calendar-parasha-name - (car parasha)) - (hebrew-calendar-parasha-name - (cdr parasha))) - (format "%s (Israel)" - (hebrew-calendar-parasha-name - (cdr parasha)))) - (hebrew-calendar-parasha-name parasha))))))))) + (format + "Parashat %s" + (if (listp parasha) ; Israel differs from diaspora + (if (car parasha) + (format "%s (diaspora), %s (Israel)" + (hebrew-calendar-parasha-name + (car parasha)) + (hebrew-calendar-parasha-name + (cdr parasha))) + (format "%s (Israel)" + (hebrew-calendar-parasha-name + (cdr parasha)))) + (hebrew-calendar-parasha-name parasha))))))))) ;; The seven ordinary year types (keviot). (defconst hebrew-calendar-year-Saturday-incomplete-Sunday [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] - 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] - 43 44 45 46 47 48 49 50] + 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] + 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover start on Sunday.") (defconst hebrew-calendar-year-Saturday-complete-Tuesday [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] - 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] - 43 44 45 46 47 48 49 [50 51]] + 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] + 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Tuesday.") (defconst hebrew-calendar-year-Monday-incomplete-Tuesday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] - 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] - 43 44 45 46 47 48 49 [50 51]] + 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] + 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover start on Tuesday.") (defconst hebrew-calendar-year-Monday-complete-Thursday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] - 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) - (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] + 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) + (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Thursday.") (defconst hebrew-calendar-year-Tuesday-regular-Thursday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] - 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) - (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] + 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) + (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover start on Thursday.") (defconst hebrew-calendar-year-Thursday-regular-Saturday [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23 - 24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30) - (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 - 49 50] + 24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30) + (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 + 49 50] "The structure of the parashiot. Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover start on Saturday.") (defconst hebrew-calendar-year-Thursday-complete-Sunday [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 - 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] - 43 44 45 46 47 48 49 50] + 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] + 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Sunday.") @@ -1186,58 +1188,58 @@ have 30 days), and has Passover start on Sunday.") ;; The seven leap year types (keviot). (defconst hebrew-calendar-year-Saturday-incomplete-Tuesday [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 - 23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42] - 43 44 45 46 47 48 49 [50 51]] + 23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42] + 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover start on Tuesday.") (defconst hebrew-calendar-year-Saturday-complete-Thursday [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 - 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) - (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] + 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) + (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Thursday.") (defconst hebrew-calendar-year-Monday-incomplete-Thursday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 - 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) - (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] + 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) + (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover start on Thursday.") (defconst hebrew-calendar-year-Monday-complete-Saturday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 - 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) - (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) - (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] + 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) + (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) + (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have 30 days), and has Passover start on Saturday.") (defconst hebrew-calendar-year-Tuesday-regular-Saturday [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 - 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) - (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) - (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] + 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) + (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) + (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover start on Saturday.") (defconst hebrew-calendar-year-Thursday-incomplete-Sunday [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 - 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 - 43 44 45 46 47 48 49 50] + 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 + 43 44 45 46 47 48 49 50] "The structure of the parashiot. Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both have 29 days), and has Passover start on Sunday.") (defconst hebrew-calendar-year-Thursday-complete-Tuesday [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 - 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 - 43 44 45 46 47 48 49 [50 51]] + 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 + 43 44 45 46 47 48 49 [50 51]] "The structure of the parashiot. Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both have 30 days), and has Passover start on Tuesday.") diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el index 6cea9545898..c52b6d86a2f 100644 --- a/lisp/calendar/cal-mayan.el +++ b/lisp/calendar/cal-mayan.el @@ -4,7 +4,7 @@ ;; 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Stewart M. Clamen -;; Edward M. Reingold +;; Edward M. Reingold ;; Maintainer: Glenn Morris ;; Keywords: calendar ;; Human-Keywords: Mayan calendar, Maya, calendar, diary @@ -100,12 +100,12 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using (condition-case condition (progn (while (< cc c) - (let* ((start (string-match "[0-9]+" str cc)) - (end (match-end 0)) - datum) - (setq datum (read (substring str start end))) - (setq rlc (cons datum rlc)) - (setq cc end))) + (let* ((start (string-match "[0-9]+" str cc)) + (end (match-end 0)) + datum) + (setq datum (read (substring str start end))) + (setq rlc (cons datum rlc)) + (setq cc end))) (if (not (= (length rlc) 5)) (signal 'invalid-read-syntax nil))) (invalid-read-syntax nil)) (reverse rlc))) @@ -125,16 +125,16 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using (defun calendar-mayan-haab-difference (date1 date2) "Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2." (mod (+ (* 20 (- (cdr date2) (cdr date1))) - (- (car date2) (car date1))) + (- (car date2) (car date1))) 365)) (defun calendar-mayan-haab-on-or-before (haab-date date) "Absolute date of latest HAAB-DATE on or before absolute DATE." (- date (% (- date - (calendar-mayan-haab-difference - (calendar-mayan-haab-from-absolute 0) haab-date)) - 365))) + (calendar-mayan-haab-difference + (calendar-mayan-haab-from-absolute 0) haab-date)) + 365))) ;;;###cal-autoload (defun calendar-next-haab-date (haab-date &optional noecho) @@ -165,12 +165,12 @@ Echo Mayan date if NOECHO is t." "Convert Mayan HAAB date (a pair) into its traditional written form." (let ((month (cdr haab)) (day (car haab))) - ;; 19th month consists of 5 special days - (if (= month 19) - (format "%d Uayeb" day) - (format "%d %s" - day - (aref calendar-mayan-haab-month-name-array (1- month)))))) + ;; 19th month consists of 5 special days + (if (= month 19) + (format "%d Uayeb" day) + (format "%d %s" + day + (aref calendar-mayan-haab-month-name-array (1- month)))))) (defun calendar-mayan-tzolkin-from-absolute (date) "Convert absolute DATE into a Mayan tzolkin date (a pair)." @@ -188,17 +188,17 @@ Echo Mayan date if NOECHO is t." (let ((number-difference (- (car date2) (car date1))) (name-difference (- (cdr date2) (cdr date1)))) (mod (+ number-difference - (* 13 (mod (* 3 (- number-difference name-difference)) - 20))) - 260))) + (* 13 (mod (* 3 (- number-difference name-difference)) + 20))) + 260))) (defun calendar-mayan-tzolkin-on-or-before (tzolkin-date date) "Absolute date of latest TZOLKIN-DATE on or before absolute DATE." (- date (% (- date (calendar-mayan-tzolkin-difference - (calendar-mayan-tzolkin-from-absolute 0) - tzolkin-date)) - 260))) + (calendar-mayan-tzolkin-from-absolute 0) + tzolkin-date)) + 260))) ;;;###cal-autoload (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho) @@ -247,8 +247,8 @@ Returns nil if such a tzolkin-haab combination is impossible." (if (= (% difference 5) 0) (- date (mod (- date - (+ haab-difference (* 365 difference))) - 18980)) + (+ haab-difference (* 365 difference))) + 18980)) nil))) (defun calendar-read-mayan-haab-date () @@ -276,9 +276,9 @@ Returns nil if such a tzolkin-haab combination is impossible." (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil)) (tzolkin-name (cdr (assoc-string - (completing-read "Tzolkin uinal: " - (mapcar 'list tzolkin-name-list) - nil t) + (completing-read "Tzolkin uinal: " + (mapcar 'list tzolkin-name-list) + nil t) (calendar-make-alist tzolkin-name-list 1) t)))) (cons tzolkin-count tzolkin-name))) @@ -321,12 +321,12 @@ Echo Mayan date if NOECHO is t." (defun calendar-absolute-from-mayan-long-count (c) "Compute the absolute date corresponding to the Mayan Long Count C. Long count is a list (baktun katun tun uinal kin)" - (+ (* (nth 0 c) 144000) ; baktun - (* (nth 1 c) 7200) ; katun - (* (nth 2 c) 360) ; tun - (* (nth 3 c) 20) ; uinal - (nth 4 c) ; kin (days) - (- ; days before absolute date 0 + (+ (* (nth 0 c) 144000) ; baktun + (* (nth 1 c) 7200) ; katun + (* (nth 2 c) 360) ; tun + (* (nth 3 c) 20) ; uinal + (nth 4 c) ; kin (days) + (- ; days before absolute date 0 calendar-mayan-days-before-absolute-zero))) ;;;###cal-autoload @@ -338,10 +338,10 @@ Defaults to today's date if DATE is not given." (tzolkin (calendar-mayan-tzolkin-from-absolute d)) (haab (calendar-mayan-haab-from-absolute d)) (long-count (calendar-mayan-long-count-from-absolute d))) - (format "Long count = %s; tzolkin = %s; haab = %s" - (calendar-mayan-long-count-to-string long-count) - (calendar-mayan-tzolkin-to-string tzolkin) - (calendar-mayan-haab-to-string haab)))) + (format "Long count = %s; tzolkin = %s; haab = %s" + (calendar-mayan-long-count-to-string long-count) + (calendar-mayan-tzolkin-to-string tzolkin) + (calendar-mayan-haab-to-string haab)))) ;;;###cal-autoload (defun calendar-print-mayan-date () @@ -361,8 +361,8 @@ Defaults to today's date if DATE is not given." (read-string "Mayan long count (baktun.katun.tun.uinal.kin): " (calendar-mayan-long-count-to-string (calendar-mayan-long-count-from-absolute - (calendar-absolute-from-gregorian - (calendar-current-date)))))))) + (calendar-absolute-from-gregorian + (calendar-current-date)))))))) (if (calendar-mayan-long-count-common-era datum) (setq lc datum)))) (list lc))) diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index f458ebec2f7..fffe0b3d462 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el @@ -4,7 +4,7 @@ ;; Free Software Foundation, Inc. ;; Author: Edward M. Reingold -;; Lara Rios +;; Lara Rios ;; Maintainer: Glenn Morris ;; Keywords: calendar ;; Human-Keywords: calendar, popup menus, menu bar diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el index e28542b7c21..92e569e0a59 100644 --- a/lisp/calendar/cal-move.el +++ b/lisp/calendar/cal-move.el @@ -318,21 +318,21 @@ Moves forward if ARG is negative." (defun calendar-cursor-to-visible-date (date) "Move the cursor to DATE that is on the screen." (let* ((month (extract-calendar-month date)) - (day (extract-calendar-day date)) - (year (extract-calendar-year date)) - (first-of-month-weekday (calendar-day-of-week (list month 1 year)))) + (day (extract-calendar-day date)) + (year (extract-calendar-year date)) + (first-of-month-weekday (calendar-day-of-week (list month 1 year)))) (goto-line (+ 3 - (/ (+ day -1 + (/ (+ day -1 (mod (- (calendar-day-of-week (list month 1 year)) calendar-week-start-day) 7)) 7))) (move-to-column (+ 6 - (* 25 - (1+ (calendar-interval - displayed-month displayed-year month year))) - (* 3 (mod + (* 25 + (1+ (calendar-interval + displayed-month displayed-year month year))) + (* 3 (mod (- (calendar-day-of-week date) calendar-week-start-day) 7)))))) diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 9906fa7c5ec..b8d0dcb1634 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -1280,7 +1280,7 @@ are non-nil. Pages are ruled if `cal-tex-rules' is non-nil." (cal-tex-list-diary-entries ;; FIXME d1? (calendar-absolute-from-gregorian (list month 1 year)) - d2)))) + d2)))) (cal-tex-preamble "twoside") (cal-tex-cmd "\\textwidth 3.25in") (cal-tex-cmd "\\textheight 6.5in") diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el index 12612ac9ac7..2dfaa7c0a0b 100644 --- a/lisp/calendar/cal-x.el +++ b/lisp/calendar/cal-x.el @@ -4,7 +4,7 @@ ;; 2008 Free Software Foundation, Inc. ;; Author: Michael Kifer -;; Edward M. Reingold +;; Edward M. Reingold ;; Maintainer: Glenn Morris ;; Keywords: calendar ;; Human-Keywords: calendar, dedicated frames, X Window System @@ -91,11 +91,11 @@ passed to `calendar-basic-setup'." (save-window-excursion (save-excursion (setq calendar-frame - (make-frame calendar-and-diary-frame-parameters)) + (make-frame calendar-and-diary-frame-parameters)) (run-hooks 'calendar-after-frame-setup-hooks) (select-frame calendar-frame) (if (eq 'icon (cdr (assoc 'visibility - (frame-parameters calendar-frame)))) + (frame-parameters calendar-frame)))) (iconify-or-deiconify-frame)) (calendar-basic-setup arg) (set-window-dedicated-p (selected-window) t) @@ -122,11 +122,11 @@ ARG is passed to `calendar-basic-setup'." (save-window-excursion (save-excursion (setq calendar-frame - (make-frame calendar-frame-parameters)) + (make-frame calendar-frame-parameters)) (run-hooks 'calendar-after-frame-setup-hooks) (select-frame calendar-frame) (if (eq 'icon (cdr (assoc 'visibility - (frame-parameters calendar-frame)))) + (frame-parameters calendar-frame)))) (iconify-or-deiconify-frame)) (calendar-basic-setup arg) (set-window-dedicated-p (selected-window) t)))))) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 0aa97e4fa78..bb0ed3d045c 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -494,14 +494,14 @@ calendar package is already loaded). Rather, use either "List of pseudo-patterns describing the American patterns of date used. See the documentation of `diary-date-forms' for an explanation." :type '(repeat (choice (cons :tag "Backup" - :value (backup . nil) - (const backup) - (repeat (list :inline t :format "%v" - (symbol :tag "Keyword") - (choice symbol regexp)))) - (repeat (list :inline t :format "%v" - (symbol :tag "Keyword") - (choice symbol regexp))))) + :value (backup . nil) + (const backup) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp)))) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp))))) :group 'diary) (defcustom european-date-diary-pattern @@ -513,14 +513,14 @@ See the documentation of `diary-date-forms' for an explanation." "List of pseudo-patterns describing the European patterns of date used. See the documentation of `diary-date-forms' for an explanation." :type '(repeat (choice (cons :tag "Backup" - :value (backup . nil) - (const backup) - (repeat (list :inline t :format "%v" - (symbol :tag "Keyword") - (choice symbol regexp)))) - (repeat (list :inline t :format "%v" - (symbol :tag "Keyword") - (choice symbol regexp))))) + :value (backup . nil) + (const backup) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp)))) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp))))) :group 'diary) (defvar diary-font-lock-keywords) @@ -554,14 +554,14 @@ directive causes the date recognizer to back up to the beginning of the current word of the diary entry, so in no case can the pattern match more than a portion of the first word of the diary entry." :type '(repeat (choice (cons :tag "Backup" - :value (backup . nil) - (const backup) - (repeat (list :inline t :format "%v" - (symbol :tag "Keyword") - (choice symbol regexp)))) - (repeat (list :inline t :format "%v" - (symbol :tag "Keyword") - (choice symbol regexp))))) + :value (backup . nil) + (const backup) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp)))) + (repeat (list :inline t :format "%v" + (symbol :tag "Keyword") + (choice symbol regexp))))) :initialize 'custom-initialize-default :set (lambda (symbol value) (unless (equal value (eval symbol)) @@ -706,7 +706,7 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom oriental-holidays '((if (fboundp 'atan) - (holiday-chinese-new-year))) + (holiday-chinese-new-year))) "Oriental holidays. See the documentation for `calendar-holidays' for details." :type 'sexp @@ -965,24 +965,24 @@ calendar." (format "Baha'i New Year (Naw-Ruz) %d" (- displayed-year (1- 1844)))) (holiday-fixed 4 21 "First Day of Ridvan") (if all-bahai-calendar-holidays - (holiday-fixed 4 22 "Second Day of Ridvan")) + (holiday-fixed 4 22 "Second Day of Ridvan")) (if all-bahai-calendar-holidays - (holiday-fixed 4 23 "Third Day of Ridvan")) + (holiday-fixed 4 23 "Third Day of Ridvan")) (if all-bahai-calendar-holidays - (holiday-fixed 4 24 "Fourth Day of Ridvan")) + (holiday-fixed 4 24 "Fourth Day of Ridvan")) (if all-bahai-calendar-holidays - (holiday-fixed 4 25 "Fifth Day of Ridvan")) + (holiday-fixed 4 25 "Fifth Day of Ridvan")) (if all-bahai-calendar-holidays - (holiday-fixed 4 26 "Sixth Day of Ridvan")) + (holiday-fixed 4 26 "Sixth Day of Ridvan")) (if all-bahai-calendar-holidays - (holiday-fixed 4 27 "Seventh Day of Ridvan")) + (holiday-fixed 4 27 "Seventh Day of Ridvan")) (if all-bahai-calendar-holidays - (holiday-fixed 4 28 "Eighth Day of Ridvan")) + (holiday-fixed 4 28 "Eighth Day of Ridvan")) (holiday-fixed 4 29 "Ninth Day of Ridvan") (if all-bahai-calendar-holidays - (holiday-fixed 4 30 "Tenth Day of Ridvan")) + (holiday-fixed 4 30 "Tenth Day of Ridvan")) (if all-bahai-calendar-holidays - (holiday-fixed 5 1 "Eleventh Day of Ridvan")) + (holiday-fixed 5 1 "Eleventh Day of Ridvan")) (holiday-fixed 5 2 "Twelfth Day of Ridvan") (holiday-fixed 5 23 "Declaration of the Bab") (holiday-fixed 5 29 "Ascension of Baha'u'llah") @@ -990,9 +990,9 @@ calendar." (holiday-fixed 10 20 "Birth of the Bab") (holiday-fixed 11 12 "Birth of Baha'u'llah") (if all-bahai-calendar-holidays - (holiday-fixed 11 26 "Day of the Covenant")) + (holiday-fixed 11 26 "Day of the Covenant")) (if all-bahai-calendar-holidays - (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha"))) + (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha"))) "Baha'i holidays. See the documentation for `calendar-holidays' for details." :type 'sexp @@ -1003,7 +1003,7 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom solar-holidays '((if (fboundp 'atan) - (solar-equinoxes-solstices)) + (solar-equinoxes-solstices)) (if (require 'cal-dst) (funcall 'holiday-sexp @@ -1431,8 +1431,8 @@ Or, for optional MON, YR." (fit-window-to-buffer nil nil calendar-minimum-window-height)) (sit-for 0)) (if (and (boundp 'font-lock-mode) - font-lock-mode) - (font-lock-fontify-buffer)) + font-lock-mode) + (font-lock-fontify-buffer)) (and mark-holidays-in-calendar ;;; (calendar-date-is-valid-p today) ; useful for BC dates (calendar-mark-holidays) @@ -1470,7 +1470,7 @@ line." (- (calendar-day-of-week (list month 1 year)) calendar-week-start-day) 7)) - (last (calendar-last-day-of-month month year))) + (last (calendar-last-day-of-month month year))) (goto-char (point-min)) (calendar-insert-indented (calendar-string-spread @@ -1496,7 +1496,7 @@ line." (add-text-properties (- (point) 3) (1- (point)) '(mouse-face highlight - help-echo "mouse-2: menu of operations for this date")) + help-echo "mouse-2: menu of operations for this date")) (and (zerop (mod (+ i blank-days) 7)) (/= i last) (calendar-insert-indented "" 0 t) ; force onto following line @@ -1696,10 +1696,10 @@ the inserted text. Returns t." (defcustom calendar-mode-line-format (list (propertize "<" - 'help-echo "mouse-1: previous month" - 'mouse-face 'mode-line-highlight - 'keymap (make-mode-line-mouse-map 'mouse-1 - 'calendar-scroll-right)) + 'help-echo "mouse-1: previous month" + 'mouse-face 'mode-line-highlight + 'keymap (make-mode-line-mouse-map 'mouse-1 + 'calendar-scroll-right)) "Calendar" (concat (propertize @@ -1715,7 +1715,7 @@ the inserted text. Returns t." 'help-echo "mouse-1: choose another month" 'mouse-face 'mode-line-highlight 'keymap (make-mode-line-mouse-map - 'mouse-1 'mouse-calendar-other-month)) + 'mouse-1 'mouse-calendar-other-month)) " / " (propertize (substitute-command-keys @@ -1725,10 +1725,10 @@ the inserted text. Returns t." 'keymap (make-mode-line-mouse-map 'mouse-1 #'calendar-goto-today))) '(calendar-date-string (calendar-current-date) t) (propertize ">" - 'help-echo "mouse-1: next month" - 'mouse-face 'mode-line-highlight - 'keymap (make-mode-line-mouse-map - 'mouse-1 'calendar-scroll-left))) + 'help-echo "mouse-1: next month" + 'mouse-face 'mode-line-highlight + 'keymap (make-mode-line-mouse-map + 'mouse-1 'calendar-scroll-left))) "The mode line of the calendar buffer. This must be a list of items that evaluate to strings--those strings are @@ -1845,8 +1845,8 @@ the STRINGS are just concatenated and the result truncated." (let ((calendar-buffers (calendar-buffer-list)) list) (walk-windows (lambda (w) - (if (memq (window-buffer w) calendar-buffers) - (push w list))) + (if (memq (window-buffer w) calendar-buffers) + (push w list))) nil t) list)) @@ -2122,7 +2122,7 @@ If optional NODAY is t, does not ask for day, but just returns (list month year)) (list month (calendar-read (format "Day (1-%d): " last) - (lambda (x) (and (< 0 x) (<= x last)))) + (lambda (x) (and (< 0 x) (<= x last)))) year)))) (defun calendar-interval (mon1 yr1 mon2 yr2) @@ -2153,11 +2153,11 @@ each element returned has a final `.' character." (defvar calendar-font-lock-keywords `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t) - " -?[0-9]+") + " -?[0-9]+") . font-lock-function-name-face) ; month and year (,(regexp-opt (list (substring (aref calendar-day-name-array 6) 0 2) - (substring (aref calendar-day-name-array 0) 0 2))) + (substring (aref calendar-day-name-array 0) 0 2))) ;; Saturdays and Sundays are highlighted differently. . font-lock-comment-face) ;; First two chars of each day are used in the calendar. @@ -2383,17 +2383,17 @@ If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive). If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise." (if (> n 0) (+ (* 7 (1- n)) - (calendar-dayname-on-or-before - dayname - (+ 6 (calendar-absolute-from-gregorian - (list month (or day 1) year))))) + (calendar-dayname-on-or-before + dayname + (+ 6 (calendar-absolute-from-gregorian + (list month (or day 1) year))))) (+ (* 7 (1+ n)) (calendar-dayname-on-or-before - dayname - (calendar-absolute-from-gregorian - (list month - (or day (calendar-last-day-of-month month year)) - year)))))) + dayname + (calendar-absolute-from-gregorian + (list month + (or day (calendar-last-day-of-month month year)) + year)))))) (defun calendar-nth-named-day (n dayname month year &optional day) "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY. diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 4139ec340ad..dbba1ce7d26 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -54,7 +54,7 @@ are holidays." :type 'face :group 'diary) (make-obsolete-variable 'diary-face "customize the face `diary' instead." - "23.1") + "23.1") ;; Face markup of calendar and diary displays: Any entry line that ;; ends with [foo:value] where foo is a face attribute (except :box @@ -90,14 +90,14 @@ that this is a face (`:face') to apply. TYPE is the type of attribute being applied. Available TYPES (see `diary-attrtype-convert') are: `string', `symbol', `int', `tnil',`stringtnil.'" :type '(repeat (list (string :tag "Regular expression") - (integer :tag "Sub-expression") - (symbol :tag "Attribute (e.g. :foreground)") - (choice (const string :tag "A string") - (const symbol :tag "A symbol") - (const int :tag "An integer") - (const tnil :tag "`t' or `nil'") - (const stringtnil - :tag "A string, `t', or `nil'")))) + (integer :tag "Sub-expression") + (symbol :tag "Attribute (e.g. :foreground)") + (choice (const string :tag "A string") + (const symbol :tag "A symbol") + (const int :tag "An integer") + (const tnil :tag "`t' or `nil'") + (const stringtnil + :tag "A string, `t', or `nil'")))) :group 'diary) (defcustom diary-glob-file-regexp-prefix "^\\#" @@ -177,8 +177,8 @@ to cull relevant entries. You can use either or both of describes the style of such diary entries." :type 'hook :options '(list-hebrew-diary-entries - list-islamic-diary-entries - diary-bahai-list-entries) + list-islamic-diary-entries + diary-bahai-list-entries) :group 'diary) (defcustom nongregorian-diary-marking-hook nil @@ -190,8 +190,8 @@ to cull relevant entries. You can use either or both of describes the style of such diary entries." :type 'hook :options '(mark-hebrew-diary-entries - mark-islamic-diary-entries - diary-bahai-mark-entries) + mark-islamic-diary-entries + diary-bahai-mark-entries) :group 'diary) (defcustom print-diary-entries-hook 'lpr-buffer @@ -278,10 +278,10 @@ If the template is actually a function, it is called with the message body text as argument, and may use `match-string' etc. to make a template following the rules above." :type '(alist :key-type (regexp :tag "Regexp matching time/place") - :value-type (choice - (string :tag "Template for entry") - (function :tag - "Unary function providing template"))) + :value-type (choice + (string :tag "Template for entry") + (function :tag + "Unary function providing template"))) :version "22.1" :group 'diary) @@ -345,13 +345,13 @@ syntax of `*' and `:' changed to be word constituents.") "Convert string ATTRVALUE to TYPE appropriate for a face description. Valid TYPEs are: string, symbol, int, stringtnil, tnil." (cond ((eq type 'string) attrvalue) - ((eq type 'symbol) (read attrvalue)) ; FIXME intern-soft? - ((eq type 'int) (string-to-number attrvalue)) - ((eq type 'stringtnil) - (cond ((string-equal "t" attrvalue) t) - ((string-equal "nil" attrvalue) nil) - (t attrvalue))) - ((eq type 'tnil) (string-equal "t" attrvalue)))) + ((eq type 'symbol) (read attrvalue)) ; FIXME intern-soft? + ((eq type 'int) (string-to-number attrvalue)) + ((eq type 'stringtnil) + (cond ((string-equal "t" attrvalue) t) + ((string-equal "nil" attrvalue) nil) + (t attrvalue))) + ((eq type 'tnil) (string-equal "t" attrvalue)))) (defun diary-pull-attrs (entry fileglobattrs) "Search for matches for regexps from `diary-face-attrs'. @@ -363,34 +363,34 @@ When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE) pairs." (let (regexp regnum attrname attrname attrvalue type ret-attr) (if (null entry) - (save-excursion - (dolist (attr diary-face-attrs) - ;; FIXME inefficient searching. - (goto-char (point-min)) - (setq regexp (concat diary-glob-file-regexp-prefix (car attr)) - regnum (cadr attr) - attrname (nth 2 attr) - type (nth 3 attr) - attrvalue (if (re-search-forward regexp nil t) - (match-string-no-properties regnum))) - (and attrvalue - (setq attrvalue (diary-attrtype-convert attrvalue type)) - (setq ret-attr (append ret-attr - (list attrname attrvalue)))))) + (save-excursion + (dolist (attr diary-face-attrs) + ;; FIXME inefficient searching. + (goto-char (point-min)) + (setq regexp (concat diary-glob-file-regexp-prefix (car attr)) + regnum (cadr attr) + attrname (nth 2 attr) + type (nth 3 attr) + attrvalue (if (re-search-forward regexp nil t) + (match-string-no-properties regnum))) + (and attrvalue + (setq attrvalue (diary-attrtype-convert attrvalue type)) + (setq ret-attr (append ret-attr + (list attrname attrvalue)))))) (setq ret-attr fileglobattrs) (dolist (attr diary-face-attrs) - (setq regexp (car attr) - regnum (cadr attr) - attrname (nth 2 attr) - type (nth 3 attr) - attrvalue nil) - ;; FIXME multiple matches? - (if (string-match regexp entry) - (setq attrvalue (match-string-no-properties regnum entry) - entry (replace-match "" t t entry))) - (and attrvalue - (setq attrvalue (diary-attrtype-convert attrvalue type)) - (setq ret-attr (append ret-attr (list attrname attrvalue)))))) + (setq regexp (car attr) + regnum (cadr attr) + attrname (nth 2 attr) + type (nth 3 attr) + attrvalue nil) + ;; FIXME multiple matches? + (if (string-match regexp entry) + (setq attrvalue (match-string-no-properties regnum entry) + entry (replace-match "" t t entry))) + (and attrvalue + (setq attrvalue (diary-attrtype-convert attrvalue type)) + (setq ret-attr (append ret-attr (list attrname attrvalue)))))) (list entry ret-attr))) ;;;###cal-autoload @@ -471,14 +471,14 @@ This variable does not affect the diary display with the `d' command from the calendar; in that case, the prefix argument controls the number of days of diary entries displayed." :type '(choice (integer :tag "Entries") - (vector :value [0 0 0 0 0 0 0] - (integer :tag "Sunday") - (integer :tag "Monday") - (integer :tag "Tuesday") - (integer :tag "Wednesday") - (integer :tag "Thursday") - (integer :tag "Friday") - (integer :tag "Saturday"))) + (vector :value [0 0 0 0 0 0 0] + (integer :tag "Sunday") + (integer :tag "Monday") + (integer :tag "Tuesday") + (integer :tag "Wednesday") + (integer :tag "Thursday") + (integer :tag "Friday") + (integer :tag "Saturday"))) :initialize 'custom-initialize-default :set 'diary-set-maybe-redraw :group 'diary) @@ -490,7 +490,7 @@ Can be used by programs integrating a diary list into other buffers (e.g. org.el and planner.el) to modify the string or add properties to it. The function takes a string argument and must return a string.") -(defvar diary-entries-list) ; bound in diary-list-entries +(defvar diary-entries-list) ; bound in diary-list-entries (defun add-to-diary-list (date string specifier &optional marker globcolor literal) @@ -513,8 +513,8 @@ FILENAME being the file containing the diary entry." (or (string-equal prefix "") (setq string (format "[%s] %s" prefix string))))) (and diary-modify-entry-list-string-function - (setq string (funcall diary-modify-entry-list-string-function - string))) + (setq string (funcall diary-modify-entry-list-string-function + string))) (setq diary-entries-list (append diary-entries-list (list (list date string specifier @@ -567,7 +567,7 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." (aref number-of-diary-entries (calendar-day-of-week date)) number-of-diary-entries))) (when (> number 0) - (let ((original-date date) ; save for possible use in the hooks + (let ((original-date date) ; save for possible use in the hooks diary-entries-list file-glob-attrs (date-string (calendar-date-string date)) @@ -611,58 +611,58 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." (entry-found (list-sexp-diary-entries date))) (dolist (date-form diary-date-forms) (let* ((backup (when (eq (car date-form) 'backup) - (setq date-form (cdr date-form)) - t)) - (dayname - (format "%s\\|%s\\.?" - (calendar-day-name date) - (calendar-day-name date 'abbrev))) - (monthname - (format "\\*\\|%s\\|%s\\.?" - (calendar-month-name month) - (calendar-month-name month 'abbrev))) - (month (concat "\\*\\|0*" (int-to-string month))) - (day (concat "\\*\\|0*" (int-to-string day))) - (year - (concat - "\\*\\|0*" (int-to-string year) - (if abbreviated-calendar-year - (concat "\\|" (format "%02d" (% year 100))) - ""))) - (regexp - (concat - "^" mark "?\\(" - ;; This must be let* so that date-form - ;; can use day etc. - (mapconcat 'eval date-form "\\)\\(?:") - "\\)")) - (case-fold-search t)) + (setq date-form (cdr date-form)) + t)) + (dayname + (format "%s\\|%s\\.?" + (calendar-day-name date) + (calendar-day-name date 'abbrev))) + (monthname + (format "\\*\\|%s\\|%s\\.?" + (calendar-month-name month) + (calendar-month-name month 'abbrev))) + (month (concat "\\*\\|0*" (int-to-string month))) + (day (concat "\\*\\|0*" (int-to-string day))) + (year + (concat + "\\*\\|0*" (int-to-string year) + (if abbreviated-calendar-year + (concat "\\|" (format "%02d" (% year 100))) + ""))) + (regexp + (concat + "^" mark "?\\(" + ;; This must be let* so that date-form + ;; can use day etc. + (mapconcat 'eval date-form "\\)\\(?:") + "\\)")) + (case-fold-search t)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (if backup (re-search-backward "\\<" nil t)) - (if (and (bolp) (not (looking-at "[ \t]"))) + (if (and (bolp) (not (looking-at "[ \t]"))) ;; Diary entry that consists only of date. (backward-char 1) ;; Found a nonempty diary entry--make it ;; visible and add it to the list. (setq entry-found t) - (if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) + (if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) (let ((entry-start (point)) date-start temp) - (setq date-start - (line-end-position - (if (and (bolp) (> number 1)) -1 0))) - (forward-line 1) - (while (looking-at "[ \t]") - (forward-line 1)) + (setq date-start + (line-end-position + (if (and (bolp) (> number 1)) -1 0))) + (forward-line 1) + (while (looking-at "[ \t]") + (forward-line 1)) (unless (and (eobp) (not (bolp))) (backward-char 1)) (unless list-only (remove-overlays date-start (point) 'invisible 'diary)) - (setq temp (diary-pull-attrs - (buffer-substring entry-start (point)) - file-glob-attrs)) + (setq temp (diary-pull-attrs + (buffer-substring entry-start (point)) + file-glob-attrs)) (add-to-diary-list date (car temp) @@ -681,8 +681,8 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." 'list-diary-entries-hook) (unless list-only (if diary-display-hook - (run-hooks 'diary-display-hook) - (simple-diary-display))) + (run-hooks 'diary-display-hook) + (simple-diary-display))) (run-hooks 'diary-hook) diary-entries-list)))))) @@ -692,7 +692,7 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." (remove-overlays (point-min) (point-max) 'invisible 'diary) (kill-local-variable 'mode-line-format)) -(defvar original-date) ; bound in diary-list-entries +(defvar original-date) ; bound in diary-list-entries (defvar number) (defun include-other-diary-files () @@ -712,11 +712,11 @@ changing the variable `diary-include-string'." " \"\\([^\"]*\\)\"") nil t) (let ((diary-file (substitute-in-file-name - (match-string-no-properties 1))) - (diary-list-include-blanks nil) - (list-diary-entries-hook 'include-other-diary-files) - (diary-display-hook 'ignore) - (diary-hook nil)) + (match-string-no-properties 1))) + (diary-list-include-blanks nil) + (list-diary-entries-hook 'include-other-diary-files) + (diary-display-hook 'ignore) + (diary-hook nil)) (if (file-exists-p diary-file) (if (file-readable-p diary-file) (unwind-protect @@ -731,7 +731,7 @@ changing the variable `diary-include-string'." (beep) (message "Can't find included diary file %s" diary-file) (sleep-for 2)))) - (goto-char (point-min))) + (goto-char (point-min))) ;; Bound in diary-list-entries. (defvar date-string) @@ -775,7 +775,7 @@ changing the variable `diary-include-string'." (message "Preparing diary...done")))) (defface diary-button '((((type pc) (class color)) - (:foreground "lightblue"))) + (:foreground "lightblue"))) "Default face used for buttons." :version "22.1" :group 'diary) @@ -845,7 +845,7 @@ This function is provided for optional use as the `diary-display-hook'." (holiday-list-last-month 1) (holiday-list-last-year 1) (date (list 0 0 0))) - (dolist (entry entry-list) + (dolist (entry entry-list) (if (not (calendar-date-equal date (car entry))) (progn (setq date (car entry)) @@ -860,7 +860,7 @@ This function is provided for optional use as the `diary-display-hook'." ;; We need to get the holidays for the next 3 months. (setq holiday-list-last-month (extract-calendar-month date) - holiday-list-last-year + holiday-list-last-year (extract-calendar-year date)) (progn (increment-calendar-month @@ -873,62 +873,62 @@ This function is provided for optional use as the `diary-display-hook'." (increment-calendar-month holiday-list-last-month holiday-list-last-year 1)) (let (date-holiday-list) - ;; Make a list of all holidays for date. - (dolist (h holiday-list) - (if (calendar-date-equal date (car h)) - (setq date-holiday-list (append date-holiday-list - (cdr h))))) + ;; Make a list of all holidays for date. + (dolist (h holiday-list) + (if (calendar-date-equal date (car h)) + (setq date-holiday-list (append date-holiday-list + (cdr h))))) (insert (if (bobp) "" ?\n) (calendar-date-string date)) (if date-holiday-list (insert ": ")) (let ((l (current-column)) - (longest 0)) + (longest 0)) (insert (mapconcat (lambda (x) - (if (< longest (length x)) - (setq longest (length x))) - x) + (if (< longest (length x)) + (setq longest (length x))) + x) date-holiday-list (concat "\n" (make-string l ? )))) (insert ?\n (make-string (+ l longest) ?=) ?\n))))) - (let ((this-entry (cadr entry)) - this-loc) - (unless (zerop (length this-entry)) - (if (setq this-loc (nth 3 entry)) - (insert-button (concat this-entry "\n") - ;; (MARKER FILENAME SPECIFIER LITERAL) - 'locator (list (car this-loc) - (cadr this-loc) - (nth 2 entry) - (or (nth 2 this-loc) - (nth 1 entry))) - :type 'diary-entry) - (insert this-entry ?\n)) - (save-excursion - (let* ((marks (nth 4 entry)) - (faceinfo marks) - temp-face) - (when marks - (setq temp-face (make-symbol - (apply - 'concat "temp-face-" - (mapcar (lambda (sym) - (if (stringp sym) - sym - (symbol-name sym))) - marks)))) - (make-face temp-face) - ;; Remove :face info from the marks, - ;; copy the face info into temp-face - (while (setq faceinfo (memq :face faceinfo)) - (copy-face (read (nth 1 faceinfo)) temp-face) - (setcar faceinfo nil) - (setcar (cdr faceinfo) nil)) - (setq marks (delq nil marks)) - ;; Apply the font aspects. - (apply 'set-face-attribute temp-face nil marks) - (search-backward this-entry) - (overlay-put - (make-overlay (match-beginning 0) (match-end 0)) - 'face temp-face)))))))) + (let ((this-entry (cadr entry)) + this-loc) + (unless (zerop (length this-entry)) + (if (setq this-loc (nth 3 entry)) + (insert-button (concat this-entry "\n") + ;; (MARKER FILENAME SPECIFIER LITERAL) + 'locator (list (car this-loc) + (cadr this-loc) + (nth 2 entry) + (or (nth 2 this-loc) + (nth 1 entry))) + :type 'diary-entry) + (insert this-entry ?\n)) + (save-excursion + (let* ((marks (nth 4 entry)) + (faceinfo marks) + temp-face) + (when marks + (setq temp-face (make-symbol + (apply + 'concat "temp-face-" + (mapcar (lambda (sym) + (if (stringp sym) + sym + (symbol-name sym))) + marks)))) + (make-face temp-face) + ;; Remove :face info from the marks, + ;; copy the face info into temp-face + (while (setq faceinfo (memq :face faceinfo)) + (copy-face (read (nth 1 faceinfo)) temp-face) + (setcar faceinfo nil) + (setcar (cdr faceinfo) nil)) + (setq marks (delq nil marks)) + ;; Apply the font aspects. + (apply 'set-face-attribute temp-face nil marks) + (search-backward this-entry) + (overlay-put + (make-overlay (match-beginning 0) (match-end 0)) + 'face temp-face)))))))) (set-buffer-modified-p nil) (goto-char (point-min)) (setq buffer-read-only t) @@ -1166,11 +1166,11 @@ diary entries." (+ y 100) y))) (string-to-number y-str))))) - (setq marks (nth 1 - (diary-pull-attrs - (buffer-substring-no-properties - (point) (line-end-position)) - file-glob-attrs))) + (setq marks (nth 1 + (diary-pull-attrs + (buffer-substring-no-properties + (point) (line-end-position)) + file-glob-attrs))) (if dd-name (mark-calendar-days-named (cdr (assoc-string @@ -1192,7 +1192,7 @@ diary entries." 'mark-diary-entries-hook)) (message "Marking diary entries...done"))))) -(defvar displayed-year) ; bound in generate-calendar +(defvar displayed-year) ; bound in generate-calendar (defvar displayed-month) (defun mark-sexp-diary-entries () @@ -1226,7 +1226,7 @@ is marked. See the documentation for the function `list-sexp-diary-entries'." (setq sexp (buffer-substring-no-properties sexp-start (point))) (forward-char 1) (if (and (bolp) (not (looking-at "[ \t]"))) - ;; Diary entry consists only of the sexp. + ;; Diary entry consists only of the sexp. (progn (backward-char 1) (setq entry "")) @@ -1238,17 +1238,17 @@ is marked. See the documentation for the function `list-sexp-diary-entries'." (if (bolp) (backward-char 1)) (setq entry (buffer-substring-no-properties entry-start (point)))) (calendar-for-loop date from first-date to last-date do - (if (setq mark (diary-sexp-entry sexp entry - (calendar-gregorian-from-absolute date))) - (progn - (setq marks (diary-pull-attrs entry file-glob-attrs) - marks (nth 1 (diary-pull-attrs entry file-glob-attrs))) - (mark-visible-calendar-date - (calendar-gregorian-from-absolute date) - (if (< 0 (length marks)) - marks - (if (consp mark) - (car mark))))))))))) + (if (setq mark (diary-sexp-entry sexp entry + (calendar-gregorian-from-absolute date))) + (progn + (setq marks (diary-pull-attrs entry file-glob-attrs) + marks (nth 1 (diary-pull-attrs entry file-glob-attrs))) + (mark-visible-calendar-date + (calendar-gregorian-from-absolute date) + (if (< 0 (length marks)) + marks + (if (consp mark) + (car mark))))))))))) (defun mark-included-diary-files () "Mark the diary entries from other diary files with those of the diary file. @@ -1299,11 +1299,11 @@ Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK." (increment-calendar-month prev-month prev-year -1) (setq day (calendar-absolute-from-gregorian (calendar-nth-named-day 1 dayname prev-month prev-year)) - last-day (calendar-absolute-from-gregorian - (calendar-nth-named-day -1 dayname succ-month succ-year))) + last-day (calendar-absolute-from-gregorian + (calendar-nth-named-day -1 dayname succ-month succ-year))) (while (<= day last-day) (mark-visible-calendar-date (calendar-gregorian-from-absolute day) - color) + color) (setq day (+ day 7)))))) (defun mark-calendar-date-pattern (month day year &optional color) @@ -1328,8 +1328,8 @@ Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK." (or (zerop p-year) (= year p-year)))) (if (zerop p-day) (calendar-for-loop - i from 1 to (calendar-last-day-of-month month year) do - (mark-visible-calendar-date (list month i year) color)) + i from 1 to (calendar-last-day-of-month month year) do + (mark-visible-calendar-date (list month i year) color)) (mark-visible-calendar-date (list month p-day year) color)))) (defun sort-diary-entries () @@ -1355,23 +1355,23 @@ The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam, XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can be used instead of a colon (:) to separate the hour and minute parts." (let ((case-fold-search nil)) - (cond ((string-match ; military time - "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" + (cond ((string-match ; military time + "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s) - (+ (* 100 (string-to-number (match-string 1 s))) - (string-to-number (match-string 2 s)))) - ((string-match ; hour only (XXam or XXpm) - "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) - (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) - (if (equal ?a (downcase (aref s (match-beginning 2)))) - 0 1200))) - ((string-match ; hour and minute (XX:XXam or XX:XXpm) - "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) - (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) - (string-to-number (match-string 2 s)) - (if (equal ?a (downcase (aref s (match-beginning 3)))) - 0 1200))) - (t diary-unknown-time)))) ; unrecognizable + (+ (* 100 (string-to-number (match-string 1 s))) + (string-to-number (match-string 2 s)))) + ((string-match ; hour only (XXam or XXpm) + "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) + (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) + (if (equal ?a (downcase (aref s (match-beginning 2)))) + 0 1200))) + ((string-match ; hour and minute (XX:XXam or XX:XXpm) + "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) + (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) + (string-to-number (match-string 2 s)) + (if (equal ?a (downcase (aref s (match-beginning 3)))) + 0 1200))) + (t diary-unknown-time)))) ; unrecognizable (defun list-sexp-diary-entries (date) "Add sexp entries for DATE from the diary file to `diary-entries-list'. @@ -1557,7 +1557,7 @@ best if they are nonmarking." entry-start (1+ line-start)) (forward-char 1) (if (and (bolp) (not (looking-at "[ \t]"))) - ;; Diary entry consists only of the sexp. + ;; Diary entry consists only of the sexp. (progn (backward-char 1) (setq entry "")) @@ -1604,9 +1604,9 @@ best if they are nonmarking." diary-file sexp) (sleep-for 2)))))) (cond ((stringp result) result) - ((and (consp result) - (stringp (cdr result))) result) - (result entry) + ((and (consp result) + (stringp (cdr result))) result) + (result entry) (t nil)))) (defvar date) @@ -1676,15 +1676,15 @@ backward from the end of the month. An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. Optional MARK specifies a face or single-character string to use when highlighting the day in the calendar." -;; This is messy because the diary entry may apply, but the date on which it -;; is based can be in a different month/year. For example, asking for the -;; first Monday after December 30. For large values of |n| the problem is -;; more grotesque. + ;; This is messy because the diary entry may apply, but the date on which it + ;; is based can be in a different month/year. For example, asking for the + ;; first Monday after December 30. For large values of |n| the problem is + ;; more grotesque. (and (= dayname (calendar-day-of-week date)) (let* ((m (extract-calendar-month date)) (d (extract-calendar-day date)) (y (extract-calendar-year date)) - ;; Last (n>0) or first (n<0) possible base date for entry. + ;; Last (n>0) or first (n<0) possible base date for entry. (limit (calendar-nth-named-absday (- n) dayname m y d)) (last-abs (if (> n 0) limit (+ limit 6))) @@ -1699,38 +1699,38 @@ highlighting the day in the calendar." (m2 (extract-calendar-month last)) (d2 (extract-calendar-day last)) (y2 (extract-calendar-year last))) - (if (or (and (= m1 m2) ; only possible base dates in one month - (or (eq month t) - (if (listp month) + (if (or (and (= m1 m2) ; only possible base dates in one month + (or (eq month t) + (if (listp month) (memq m1 month) - (= m1 month))) - (let ((d (or day (if (> n 0) - 1 - (calendar-last-day-of-month m1 y1))))) - (and (<= d1 d) (<= d d2)))) - ;; Only possible base dates straddle two months. - (and (or (< y1 y2) - (and (= y1 y2) (< m1 m2))) - (or - ;; m1, d1 works as a base date. - (and - (or (eq month t) - (if (listp month) + (= m1 month))) + (let ((d (or day (if (> n 0) + 1 + (calendar-last-day-of-month m1 y1))))) + (and (<= d1 d) (<= d d2)))) + ;; Only possible base dates straddle two months. + (and (or (< y1 y2) + (and (= y1 y2) (< m1 m2))) + (or + ;; m1, d1 works as a base date. + (and + (or (eq month t) + (if (listp month) (memq m1 month) - (= m1 month))) - (<= d1 (or day (if (> n 0) - 1 - (calendar-last-day-of-month m1 y1))))) - ;; m2, d2 works as a base date. - (and (or (eq month t) - (if (listp month) + (= m1 month))) + (<= d1 (or day (if (> n 0) + 1 + (calendar-last-day-of-month m1 y1))))) + ;; m2, d2 works as a base date. + (and (or (eq month t) + (if (listp month) (memq m2 month) - (= m2 month))) - (<= (or day (if (> n 0) - 1 - (calendar-last-day-of-month m2 y2))) - d2))))) - (cons mark entry))))) + (= m2 month))) + (<= (or day (if (> n 0) + 1 + (calendar-last-day-of-month m2 y2))) + d2))))) + (cons mark entry))))) ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. (defun diary-anniversary (month day &optional year mark) @@ -1818,7 +1818,7 @@ marked on the calendar." diary-entry) ;; Diary entry may apply to `days' before date. ((and (integerp days) - (not diary-entry) ; diary entry does not apply to date + (not diary-entry) ; diary entry does not apply to date (or (not marking-diary-entries) marking)) (let ((date (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian date) days)))) @@ -1926,21 +1926,21 @@ Prefix argument ARG makes the entry nonmarking." (if european-calendar-style '(day " " month " " year) '(month " " day " " year))) - (cursor (calendar-cursor-to-date t)) - (mark (or (car calendar-mark-ring) - (error "No mark set in this buffer"))) - start end) + (cursor (calendar-cursor-to-date t)) + (mark (or (car calendar-mark-ring) + (error "No mark set in this buffer"))) + start end) (if (< (calendar-absolute-from-gregorian mark) (calendar-absolute-from-gregorian cursor)) (setq start mark end cursor) (setq start cursor - end mark)) + end mark)) (make-diary-entry (format "%s(diary-block %s %s)" - sexp-diary-entry-symbol - (calendar-date-string start nil t) - (calendar-date-string end nil t)) + sexp-diary-entry-symbol + (calendar-date-string start nil t) + (calendar-date-string end nil t)) arg))) ;;;###cal-autoload @@ -2065,13 +2065,13 @@ Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'." "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)") limit t) (condition-case nil - (save-restriction - (narrow-to-region (point-min) limit) - (let ((start (point))) - (forward-sexp 1) - (store-match-data (list start (point))) - t)) - (error t)))) + (save-restriction + (narrow-to-region (point-min) limit) + (let ((start (point))) + (forward-sexp 1) + (store-match-data (list start (point))) + t)) + (error t)))) (defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array) "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. @@ -2088,21 +2088,21 @@ names." (day "\\([0-9]+\\|\\*\\)") (year "-?\\([0-9]+\\|\\*\\)")) (mapcar (lambda (x) - (cons - (concat "^" (regexp-quote diary-nonmarking-symbol) "?" - (if symbol (regexp-quote symbol) "") "\\(" - (mapconcat 'eval - ;; If backup, omit first item (backup) - ;; and last item (not part of date). - (if (equal (car x) 'backup) + (cons + (concat "^" (regexp-quote diary-nonmarking-symbol) "?" + (if symbol (regexp-quote symbol) "") "\\(" + (mapconcat 'eval + ;; If backup, omit first item (backup) + ;; and last item (not part of date). + (if (equal (car x) 'backup) (nreverse (cdr (reverse (cdr x)))) - x) - "") - ;; With backup, last item is not part of date. - (if (equal (car x) 'backup) - (concat "\\)" (eval (car (reverse x)))) - "\\)")) - '(1 diary-face))) + x) + "") + ;; With backup, last item is not part of date. + (if (equal (car x) 'backup) + (concat "\\)" (eval (car (reverse x)))) + "\\)")) + '(1 diary-face))) diary-date-forms))) (defvar calendar-hebrew-month-name-array-leap-year) @@ -2130,9 +2130,9 @@ names." (diary-font-lock-date-forms calendar-islamic-month-name-array islamic-diary-entry-symbol)) (when (or (memq 'diary-bahai-mark-entries - nongregorian-diary-marking-hook) - (memq 'diary-bahai-list-entries - nongregorian-diary-marking-hook)) + nongregorian-diary-marking-hook) + (memq 'diary-bahai-list-entries + nongregorian-diary-marking-hook)) (require 'cal-bahai) (diary-font-lock-date-forms calendar-bahai-month-name-array bahai-diary-entry-symbol)) @@ -2142,22 +2142,22 @@ names." 'font-lock-keyword-face) (cons (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol) - (regexp-quote sexp-diary-entry-symbol)) + (regexp-quote sexp-diary-entry-symbol)) '(1 font-lock-reference-face)) (cons (format "^%s" (regexp-quote diary-nonmarking-symbol)) 'font-lock-reference-face) (cons (format "^%s?%s" (regexp-quote diary-nonmarking-symbol) - (regexp-opt (mapcar 'regexp-quote - (list hebrew-diary-entry-symbol - islamic-diary-entry-symbol - bahai-diary-entry-symbol)) - t)) + (regexp-opt (mapcar 'regexp-quote + (list hebrew-diary-entry-symbol + islamic-diary-entry-symbol + bahai-diary-entry-symbol)) + t)) '(1 font-lock-reference-face)) '(diary-font-lock-sexps . font-lock-keyword-face) `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp - diary-time-regexp) + diary-time-regexp) . 'diary-time)))) (defvar diary-font-lock-keywords (diary-font-lock-keywords) @@ -2184,23 +2184,23 @@ message contains an appointment, don't make a diary entry." (catch 'finished (let (format-string) (dotimes (i (length diary-outlook-formats)) - (when (eq 0 (string-match (car (nth i diary-outlook-formats)) - body)) - (unless test-only - (setq format-string (cdr (nth i diary-outlook-formats))) - (save-excursion - (save-window-excursion - ;; Fixme: References to optional fields in the format - ;; are treated literally, not replaced by the empty - ;; string. I think this is an Emacs bug. - (make-diary-entry - (format (replace-match (if (functionp format-string) - (funcall format-string body) - format-string) - t nil (match-string 0 body)) - subject)) - (save-buffer)))) - (throw 'finished t)))) + (when (eq 0 (string-match (car (nth i diary-outlook-formats)) + body)) + (unless test-only + (setq format-string (cdr (nth i diary-outlook-formats))) + (save-excursion + (save-window-excursion + ;; Fixme: References to optional fields in the format + ;; are treated literally, not replaced by the empty + ;; string. I think this is an Emacs bug. + (make-diary-entry + (format (replace-match (if (functionp format-string) + (funcall format-string body) + format-string) + t nil (match-string 0 body)) + subject)) + (save-buffer)))) + (throw 'finished t)))) nil)) (defun diary-from-outlook (&optional noconfirm) @@ -2211,11 +2211,11 @@ function is called interactively), then if an entry is found the user is asked to confirm its addition." (interactive "p") (let ((func (cond - ((eq major-mode 'rmail-mode) - #'diary-from-outlook-rmail) - ((memq major-mode '(gnus-summary-mode gnus-article-mode)) - #'diary-from-outlook-gnus) - (t (error "Don't know how to snarf in `%s'" major-mode))))) + ((eq major-mode 'rmail-mode) + #'diary-from-outlook-rmail) + ((memq major-mode '(gnus-summary-mode gnus-article-mode)) + #'diary-from-outlook-gnus) + (t (error "Don't know how to snarf in `%s'" major-mode))))) (funcall func noconfirm))) @@ -2236,17 +2236,17 @@ automatically." (interactive "p") (with-current-buffer gnus-article-buffer (let ((subject (gnus-fetch-field "subject")) - (body (if gnus-article-mime-handles - ;; We're multipart. Don't get confused by part - ;; buttons &c. Assume info is in first part. - (mm-get-part (nth 1 gnus-article-mime-handles)) - (save-restriction - (gnus-narrow-to-body) - (buffer-string))))) + (body (if gnus-article-mime-handles + ;; We're multipart. Don't get confused by part + ;; buttons &c. Assume info is in first part. + (mm-get-part (nth 1 gnus-article-mime-handles)) + (save-restriction + (gnus-narrow-to-body) + (buffer-string))))) (when (diary-from-outlook-internal t) - (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) - (diary-from-outlook-internal) - (message "Diary entry added")))))) + (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) + (diary-from-outlook-internal) + (message "Diary entry added")))))) (custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus) @@ -2261,14 +2261,14 @@ user is asked to confirm its addition." (interactive "p") (with-current-buffer rmail-buffer (let ((subject (mail-fetch-field "subject")) - (body (buffer-substring (save-excursion - (rfc822-goto-eoh) - (point)) - (point-max)))) + (body (buffer-substring (save-excursion + (rfc822-goto-eoh) + (point)) + (point-max)))) (when (diary-from-outlook-internal t) - (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) - (diary-from-outlook-internal) - (message "Diary entry added")))))) + (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) + (diary-from-outlook-internal) + (message "Diary entry added")))))) (provide 'diary-lib) diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el index 3d01fbd0ce6..92b146b185c 100644 --- a/lisp/calendar/lunar.el +++ b/lisp/calendar/lunar.el @@ -165,14 +165,14 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon, ((= phase 2) (- adjustment adj)) (t adjustment))) (date (+ date adjustment)) - (date (+ date (/ (- calendar-time-zone - (solar-ephemeris-correction + (date (+ date (/ (- calendar-time-zone + (solar-ephemeris-correction (extract-calendar-year (calendar-gregorian-from-absolute (truncate date))))) - 60.0 24.0))) + 60.0 24.0))) (time (* 24 (- date (truncate date)))) - (date (calendar-gregorian-from-absolute (truncate date))) + (date (calendar-gregorian-from-absolute (truncate date))) (adj (dst-adjust-time date time))) (list (car adj) (apply 'solar-time-string (cdr adj)) phase))) @@ -261,103 +261,103 @@ use when highlighting the day in the calendar." (defun lunar-new-moon-time (k) "Astronomical (Julian) day number of K th new moon." (let* ((T (/ k 1236.85)) - (T2 (* T T)) - (T3 (* T T T)) - (T4 (* T2 T2)) - (JDE (+ 2451550.09765 - (* 29.530588853 k) - (* 0.0001337 T2) - (* -0.000000150 T3) - (* 0.00000000073 T4))) - (E (- 1 (* 0.002516 T) (* 0.0000074 T2))) - (sun-anomaly (+ 2.5534 - (* 29.10535669 k) - (* -0.0000218 T2) - (* -0.00000011 T3))) - (moon-anomaly (+ 201.5643 - (* 385.81693528 k) - (* 0.0107438 T2) - (* 0.00001239 T3) - (* -0.000000058 T4))) - (moon-argument (+ 160.7108 - (* 390.67050274 k) - (* -0.0016341 T2) - (* -0.00000227 T3) - (* 0.000000011 T4))) - (omega (+ 124.7746 - (* -1.56375580 k) - (* 0.0020691 T2) - (* 0.00000215 T3))) - (A1 (+ 299.77 (* 0.107408 k) (* -0.009173 T2))) - (A2 (+ 251.88 (* 0.016321 k))) - (A3 (+ 251.83 (* 26.641886 k))) - (A4 (+ 349.42 (* 36.412478 k))) - (A5 (+ 84.66 (* 18.206239 k))) - (A6 (+ 141.74 (* 53.303771 k))) - (A7 (+ 207.14 (* 2.453732 k))) - (A8 (+ 154.84 (* 7.306860 k))) - (A9 (+ 34.52 (* 27.261239 k))) - (A10 (+ 207.19 (* 0.121824 k))) - (A11 (+ 291.34 (* 1.844379 k))) - (A12 (+ 161.72 (* 24.198154 k))) - (A13 (+ 239.56 (* 25.513099 k))) - (A14 (+ 331.55 (* 3.592518 k))) - (correction - (+ (* -0.40720 (solar-sin-degrees moon-anomaly)) - (* 0.17241 E (solar-sin-degrees sun-anomaly)) - (* 0.01608 (solar-sin-degrees (* 2 moon-anomaly))) - (* 0.01039 (solar-sin-degrees (* 2 moon-argument))) - (* 0.00739 E (solar-sin-degrees (- moon-anomaly sun-anomaly))) - (* -0.00514 E (solar-sin-degrees (+ moon-anomaly sun-anomaly))) - (* 0.00208 E E (solar-sin-degrees (* 2 sun-anomaly))) - (* -0.00111 (solar-sin-degrees - (- moon-anomaly (* 2 moon-argument)))) - (* -0.00057 (solar-sin-degrees - (+ moon-anomaly (* 2 moon-argument)))) - (* 0.00056 E (solar-sin-degrees - (+ (* 2 moon-anomaly) sun-anomaly))) - (* -0.00042 (solar-sin-degrees (* 3 moon-anomaly))) - (* 0.00042 E (solar-sin-degrees - (+ sun-anomaly (* 2 moon-argument)))) - (* 0.00038 E (solar-sin-degrees - (- sun-anomaly (* 2 moon-argument)))) - (* -0.00024 E (solar-sin-degrees - (- (* 2 moon-anomaly) sun-anomaly))) - (* -0.00017 (solar-sin-degrees omega)) - (* -0.00007 (solar-sin-degrees - (+ moon-anomaly (* 2 sun-anomaly)))) - (* 0.00004 (solar-sin-degrees - (- (* 2 moon-anomaly) (* 2 moon-argument)))) - (* 0.00004 (solar-sin-degrees (* 3 sun-anomaly))) - (* 0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly - (* -2 moon-argument)))) - (* 0.00003 (solar-sin-degrees - (+ (* 2 moon-anomaly) (* 2 moon-argument)))) - (* -0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly - (* 2 moon-argument)))) - (* 0.00003 (solar-sin-degrees (- moon-anomaly sun-anomaly - (* -2 moon-argument)))) - (* -0.00002 (solar-sin-degrees (- moon-anomaly sun-anomaly - (* 2 moon-argument)))) - (* -0.00002 (solar-sin-degrees - (+ (* 3 moon-anomaly) sun-anomaly))) - (* 0.00002 (solar-sin-degrees (* 4 moon-anomaly))))) - (additional - (+ (* 0.000325 (solar-sin-degrees A1)) - (* 0.000165 (solar-sin-degrees A2)) - (* 0.000164 (solar-sin-degrees A3)) - (* 0.000126 (solar-sin-degrees A4)) - (* 0.000110 (solar-sin-degrees A5)) - (* 0.000062 (solar-sin-degrees A6)) - (* 0.000060 (solar-sin-degrees A7)) - (* 0.000056 (solar-sin-degrees A8)) - (* 0.000047 (solar-sin-degrees A9)) - (* 0.000042 (solar-sin-degrees A10)) - (* 0.000040 (solar-sin-degrees A11)) - (* 0.000037 (solar-sin-degrees A12)) - (* 0.000035 (solar-sin-degrees A13)) - (* 0.000023 (solar-sin-degrees A14)))) - (newJDE (+ JDE correction additional))) + (T2 (* T T)) + (T3 (* T T T)) + (T4 (* T2 T2)) + (JDE (+ 2451550.09765 + (* 29.530588853 k) + (* 0.0001337 T2) + (* -0.000000150 T3) + (* 0.00000000073 T4))) + (E (- 1 (* 0.002516 T) (* 0.0000074 T2))) + (sun-anomaly (+ 2.5534 + (* 29.10535669 k) + (* -0.0000218 T2) + (* -0.00000011 T3))) + (moon-anomaly (+ 201.5643 + (* 385.81693528 k) + (* 0.0107438 T2) + (* 0.00001239 T3) + (* -0.000000058 T4))) + (moon-argument (+ 160.7108 + (* 390.67050274 k) + (* -0.0016341 T2) + (* -0.00000227 T3) + (* 0.000000011 T4))) + (omega (+ 124.7746 + (* -1.56375580 k) + (* 0.0020691 T2) + (* 0.00000215 T3))) + (A1 (+ 299.77 (* 0.107408 k) (* -0.009173 T2))) + (A2 (+ 251.88 (* 0.016321 k))) + (A3 (+ 251.83 (* 26.641886 k))) + (A4 (+ 349.42 (* 36.412478 k))) + (A5 (+ 84.66 (* 18.206239 k))) + (A6 (+ 141.74 (* 53.303771 k))) + (A7 (+ 207.14 (* 2.453732 k))) + (A8 (+ 154.84 (* 7.306860 k))) + (A9 (+ 34.52 (* 27.261239 k))) + (A10 (+ 207.19 (* 0.121824 k))) + (A11 (+ 291.34 (* 1.844379 k))) + (A12 (+ 161.72 (* 24.198154 k))) + (A13 (+ 239.56 (* 25.513099 k))) + (A14 (+ 331.55 (* 3.592518 k))) + (correction + (+ (* -0.40720 (solar-sin-degrees moon-anomaly)) + (* 0.17241 E (solar-sin-degrees sun-anomaly)) + (* 0.01608 (solar-sin-degrees (* 2 moon-anomaly))) + (* 0.01039 (solar-sin-degrees (* 2 moon-argument))) + (* 0.00739 E (solar-sin-degrees (- moon-anomaly sun-anomaly))) + (* -0.00514 E (solar-sin-degrees (+ moon-anomaly sun-anomaly))) + (* 0.00208 E E (solar-sin-degrees (* 2 sun-anomaly))) + (* -0.00111 (solar-sin-degrees + (- moon-anomaly (* 2 moon-argument)))) + (* -0.00057 (solar-sin-degrees + (+ moon-anomaly (* 2 moon-argument)))) + (* 0.00056 E (solar-sin-degrees + (+ (* 2 moon-anomaly) sun-anomaly))) + (* -0.00042 (solar-sin-degrees (* 3 moon-anomaly))) + (* 0.00042 E (solar-sin-degrees + (+ sun-anomaly (* 2 moon-argument)))) + (* 0.00038 E (solar-sin-degrees + (- sun-anomaly (* 2 moon-argument)))) + (* -0.00024 E (solar-sin-degrees + (- (* 2 moon-anomaly) sun-anomaly))) + (* -0.00017 (solar-sin-degrees omega)) + (* -0.00007 (solar-sin-degrees + (+ moon-anomaly (* 2 sun-anomaly)))) + (* 0.00004 (solar-sin-degrees + (- (* 2 moon-anomaly) (* 2 moon-argument)))) + (* 0.00004 (solar-sin-degrees (* 3 sun-anomaly))) + (* 0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly + (* -2 moon-argument)))) + (* 0.00003 (solar-sin-degrees + (+ (* 2 moon-anomaly) (* 2 moon-argument)))) + (* -0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly + (* 2 moon-argument)))) + (* 0.00003 (solar-sin-degrees (- moon-anomaly sun-anomaly + (* -2 moon-argument)))) + (* -0.00002 (solar-sin-degrees (- moon-anomaly sun-anomaly + (* 2 moon-argument)))) + (* -0.00002 (solar-sin-degrees + (+ (* 3 moon-anomaly) sun-anomaly))) + (* 0.00002 (solar-sin-degrees (* 4 moon-anomaly))))) + (additional + (+ (* 0.000325 (solar-sin-degrees A1)) + (* 0.000165 (solar-sin-degrees A2)) + (* 0.000164 (solar-sin-degrees A3)) + (* 0.000126 (solar-sin-degrees A4)) + (* 0.000110 (solar-sin-degrees A5)) + (* 0.000062 (solar-sin-degrees A6)) + (* 0.000060 (solar-sin-degrees A7)) + (* 0.000056 (solar-sin-degrees A8)) + (* 0.000047 (solar-sin-degrees A9)) + (* 0.000042 (solar-sin-degrees A10)) + (* 0.000040 (solar-sin-degrees A11)) + (* 0.000037 (solar-sin-degrees A12)) + (* 0.000035 (solar-sin-degrees A13)) + (* 0.000023 (solar-sin-degrees A14)))) + (newJDE (+ JDE correction additional))) (+ newJDE (- (solar-ephemeris-correction (extract-calendar-year @@ -377,8 +377,8 @@ calendar-time-zone." (let* ((date (calendar-gregorian-from-absolute (floor (calendar-absolute-from-astro d)))) (year (+ (extract-calendar-year date) - (/ (calendar-day-number date) 365.25))) - (k (floor (* (- year 2000.0) 12.3685))) + (/ (calendar-day-number date) 365.25))) + (k (floor (* (- year 2000.0) 12.3685))) (date (lunar-new-moon-time k))) (while (< date d) (setq k (1+ k)) -- 2.11.4.GIT