diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/calendar/cal-bahai.el | 125 | ||||
| -rw-r--r-- | lisp/calendar/cal-dst.el | 173 | ||||
| -rw-r--r-- | lisp/calendar/cal-french.el | 98 | ||||
| -rw-r--r-- | lisp/calendar/cal-hebrew.el | 444 | ||||
| -rw-r--r-- | lisp/calendar/cal-mayan.el | 80 | ||||
| -rw-r--r-- | lisp/calendar/cal-menu.el | 2 | ||||
| -rw-r--r-- | lisp/calendar/cal-move.el | 16 | ||||
| -rw-r--r-- | lisp/calendar/cal-tex.el | 2 | ||||
| -rw-r--r-- | lisp/calendar/cal-x.el | 10 | ||||
| -rw-r--r-- | lisp/calendar/calendar.el | 128 | ||||
| -rw-r--r-- | lisp/calendar/diary-lib.el | 632 | ||||
| -rw-r--r-- | 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 @@ | |||
| 77 | The absolute date is the number of days elapsed since the (imaginary) | 77 | The absolute date is the number of days elapsed since the (imaginary) |
| 78 | Gregorian date Sunday, December 31, 1 BC." | 78 | Gregorian date Sunday, December 31, 1 BC." |
| 79 | (let* ((month (extract-calendar-month date)) | 79 | (let* ((month (extract-calendar-month date)) |
| 80 | (day (extract-calendar-day date)) | 80 | (day (extract-calendar-day date)) |
| 81 | (year (extract-calendar-year date)) | 81 | (year (extract-calendar-year date)) |
| 82 | (prior-years (+ (1- year) 1844)) | 82 | (prior-years (+ (1- year) 1844)) |
| 83 | (leap-days (- (+ (/ prior-years 4) ; leap days in prior years | 83 | (leap-days (- (+ (/ prior-years 4) ; leap days in prior years |
| 84 | (- (/ prior-years 100)) | 84 | (- (/ prior-years 100)) |
| 85 | (/ prior-years 400)) | 85 | (/ prior-years 400)) |
| 86 | calendar-bahai-leap-base))) | 86 | calendar-bahai-leap-base))) |
| 87 | (+ (1- calendar-bahai-epoch) ; days before epoch | 87 | (+ (1- calendar-bahai-epoch) ; days before epoch |
| 88 | (* 365 (1- year)) ; days in prior years | 88 | (* 365 (1- year)) ; days in prior years |
| 89 | leap-days | 89 | leap-days |
| 90 | (calendar-sum m 1 (< m month) 19) | 90 | (calendar-sum m 1 (< m month) 19) |
| 91 | (if (= month 19) 4 0) | 91 | (if (= month 19) 4 0) |
| 92 | day))) ; days so far this month | 92 | day))) ; days so far this month |
| 93 | 93 | ||
| 94 | (defun calendar-bahai-from-absolute (date) | 94 | (defun calendar-bahai-from-absolute (date) |
| 95 | "Bahá'à year corresponding to the absolute DATE." | 95 | "Bahá'à year corresponding to the absolute DATE." |
| 96 | (if (< date calendar-bahai-epoch) | 96 | (if (< date calendar-bahai-epoch) |
| 97 | (list 0 0 0) ; pre-Bahá'à date | 97 | (list 0 0 0) ; pre-Bahá'à date |
| 98 | (let* ((greg (calendar-gregorian-from-absolute date)) | 98 | (let* ((greg (calendar-gregorian-from-absolute date)) |
| 99 | (year (+ (- (extract-calendar-year greg) 1844) | 99 | (year (+ (- (extract-calendar-year greg) 1844) |
| 100 | (if (or (> (extract-calendar-month greg) 3) | 100 | (if (or (> (extract-calendar-month greg) 3) |
| 101 | (and (= (extract-calendar-month greg) 3) | 101 | (and (= (extract-calendar-month greg) 3) |
| 102 | (>= (extract-calendar-day greg) 21))) | 102 | (>= (extract-calendar-day greg) 21))) |
| 103 | 1 0))) | 103 | 1 0))) |
| 104 | (month ; search forward from Baha | 104 | (month ; search forward from Baha |
| 105 | (1+ (calendar-sum m 1 | 105 | (1+ (calendar-sum m 1 |
| 106 | (> date | 106 | (> date |
| 107 | (calendar-absolute-from-bahai | 107 | (calendar-absolute-from-bahai |
| 108 | (list m 19 year))) | 108 | (list m 19 year))) |
| 109 | 1))) | 109 | 1))) |
| 110 | (day ; calculate the day by subtraction | 110 | (day ; calculate the day by subtraction |
| 111 | (- date | 111 | (- date |
| 112 | (1- (calendar-absolute-from-bahai (list month 1 year)))))) | 112 | (1- (calendar-absolute-from-bahai (list month 1 year)))))) |
| @@ -117,25 +117,25 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 117 | "String of Bahá'à date of Gregorian DATE. | 117 | "String of Bahá'à date of Gregorian DATE. |
| 118 | Defaults to today's date if DATE is not given." | 118 | Defaults to today's date if DATE is not given." |
| 119 | (let* ((bahai-date (calendar-bahai-from-absolute | 119 | (let* ((bahai-date (calendar-bahai-from-absolute |
| 120 | (calendar-absolute-from-gregorian | 120 | (calendar-absolute-from-gregorian |
| 121 | (or date (calendar-current-date))))) | 121 | (or date (calendar-current-date))))) |
| 122 | (y (extract-calendar-year bahai-date)) | 122 | (y (extract-calendar-year bahai-date)) |
| 123 | (m (extract-calendar-month bahai-date)) | 123 | (m (extract-calendar-month bahai-date)) |
| 124 | (d (extract-calendar-day bahai-date))) | 124 | (d (extract-calendar-day bahai-date))) |
| 125 | (let ((monthname | 125 | (let ((monthname |
| 126 | (if (and (= m 19) | 126 | (if (and (= m 19) |
| 127 | (<= d 0)) | 127 | (<= d 0)) |
| 128 | "Ayyám-i-Há" | 128 | "Ayyám-i-Há" |
| 129 | (aref calendar-bahai-month-name-array (1- m)))) | 129 | (aref calendar-bahai-month-name-array (1- m)))) |
| 130 | (day (int-to-string | 130 | (day (int-to-string |
| 131 | (if (<= d 0) | 131 | (if (<= d 0) |
| 132 | (if (calendar-bahai-leap-year-p y) | 132 | (if (calendar-bahai-leap-year-p y) |
| 133 | (+ d 5) | 133 | (+ d 5) |
| 134 | (+ d 4)) | 134 | (+ d 4)) |
| 135 | d))) | 135 | d))) |
| 136 | (dayname nil) | 136 | (dayname nil) |
| 137 | (month (int-to-string m)) | 137 | (month (int-to-string m)) |
| 138 | (year (int-to-string y))) | 138 | (year (int-to-string y))) |
| 139 | (mapconcat 'eval calendar-date-display-form "")))) | 139 | (mapconcat 'eval calendar-date-display-form "")))) |
| 140 | 140 | ||
| 141 | ;;;###cal-autoload | 141 | ;;;###cal-autoload |
| @@ -166,15 +166,15 @@ Echo Bahá'à date unless NOECHO is t." | |||
| 166 | (calendar-absolute-from-gregorian today)))))) | 166 | (calendar-absolute-from-gregorian today)))))) |
| 167 | (completion-ignore-case t) | 167 | (completion-ignore-case t) |
| 168 | (month (cdr (assoc | 168 | (month (cdr (assoc |
| 169 | (completing-read | 169 | (completing-read |
| 170 | "Bahá'à calendar month name: " | 170 | "Bahá'à calendar month name: " |
| 171 | (mapcar 'list | 171 | (mapcar 'list |
| 172 | (append calendar-bahai-month-name-array nil)) | 172 | (append calendar-bahai-month-name-array nil)) |
| 173 | nil t) | 173 | nil t) |
| 174 | (calendar-make-alist calendar-bahai-month-name-array | 174 | (calendar-make-alist calendar-bahai-month-name-array |
| 175 | 1)))) | 175 | 1)))) |
| 176 | (day (calendar-read "Bahá'à calendar day (1-19): " | 176 | (day (calendar-read "Bahá'à calendar day (1-19): " |
| 177 | (lambda (x) (and (< 0 x) (<= x 19)))))) | 177 | (lambda (x) (and (< 0 x) (<= x 19)))))) |
| 178 | (list (list month day year)))) | 178 | (list (list month day year)))) |
| 179 | 179 | ||
| 180 | (defvar displayed-month) | 180 | (defvar displayed-month) |
| @@ -187,15 +187,15 @@ If MONTH, DAY (Bahá'Ã) is visible, the value returned is corresponding | |||
| 187 | Gregorian date in the form of the list (((month day year) STRING)). Returns | 187 | Gregorian date in the form of the list (((month day year) STRING)). Returns |
| 188 | nil if it is not visible in the current calendar window." | 188 | nil if it is not visible in the current calendar window." |
| 189 | (let* ((bahai-date (calendar-bahai-from-absolute | 189 | (let* ((bahai-date (calendar-bahai-from-absolute |
| 190 | (calendar-absolute-from-gregorian | 190 | (calendar-absolute-from-gregorian |
| 191 | (list displayed-month 15 displayed-year)))) | 191 | (list displayed-month 15 displayed-year)))) |
| 192 | (m (extract-calendar-month bahai-date)) | 192 | (m (extract-calendar-month bahai-date)) |
| 193 | (y (extract-calendar-year bahai-date)) | 193 | (y (extract-calendar-year bahai-date)) |
| 194 | (date)) | 194 | (date)) |
| 195 | (if (< m 1) | 195 | (if (< m 1) |
| 196 | nil ; Bahá'à calendar doesn't apply | 196 | nil ; Bahá'à calendar doesn't apply |
| 197 | (increment-calendar-month m y (- 10 month)) | 197 | (increment-calendar-month m y (- 10 month)) |
| 198 | (if (> m 7) ; Bahá'à date might be visible | 198 | (if (> m 7) ; Bahá'à date might be visible |
| 199 | (let ((date (calendar-gregorian-from-absolute | 199 | (let ((date (calendar-gregorian-from-absolute |
| 200 | (calendar-absolute-from-bahai (list month day y))))) | 200 | (calendar-absolute-from-bahai (list month day y))))) |
| 201 | (if (calendar-date-is-visible-p date) | 201 | (if (calendar-date-is-visible-p date) |
| @@ -406,7 +406,7 @@ part of `nongregorian-diary-marking-hook'." | |||
| 406 | (cdr (assoc-string | 406 | (cdr (assoc-string |
| 407 | mm-name | 407 | mm-name |
| 408 | (calendar-make-alist | 408 | (calendar-make-alist |
| 409 | calendar-bahai-month-name-array) | 409 | calendar-bahai-month-name-array) |
| 410 | t))))) | 410 | t))))) |
| 411 | (calendar-bahai-mark-date-pattern mm dd yy))))) | 411 | (calendar-bahai-mark-date-pattern mm dd yy))))) |
| 412 | (setq d (cdr d))))) | 412 | (setq d (cdr d))))) |
| @@ -427,15 +427,15 @@ A value of 0 in any position is a wildcard." | |||
| 427 | (mark-visible-calendar-date date))) | 427 | (mark-visible-calendar-date date))) |
| 428 | ;; Month and day in any year--this taken from the holiday stuff. | 428 | ;; Month and day in any year--this taken from the holiday stuff. |
| 429 | (let* ((bahai-date (calendar-bahai-from-absolute | 429 | (let* ((bahai-date (calendar-bahai-from-absolute |
| 430 | (calendar-absolute-from-gregorian | 430 | (calendar-absolute-from-gregorian |
| 431 | (list displayed-month 15 displayed-year)))) | 431 | (list displayed-month 15 displayed-year)))) |
| 432 | (m (extract-calendar-month bahai-date)) | 432 | (m (extract-calendar-month bahai-date)) |
| 433 | (y (extract-calendar-year bahai-date)) | 433 | (y (extract-calendar-year bahai-date)) |
| 434 | (date)) | 434 | (date)) |
| 435 | (if (< m 1) | 435 | (if (< m 1) |
| 436 | nil ; Bahá'à calendar doesn't apply | 436 | nil ; Bahá'à calendar doesn't apply |
| 437 | (increment-calendar-month m y (- 10 month)) | 437 | (increment-calendar-month m y (- 10 month)) |
| 438 | (if (> m 7) ; Bahá'à date might be visible | 438 | (if (> m 7) ; Bahá'à date might be visible |
| 439 | (let ((date (calendar-gregorian-from-absolute | 439 | (let ((date (calendar-gregorian-from-absolute |
| 440 | (calendar-absolute-from-bahai | 440 | (calendar-absolute-from-bahai |
| 441 | (list month day y))))) | 441 | (list month day y))))) |
| @@ -457,18 +457,19 @@ A value of 0 in any position is a wildcard." | |||
| 457 | (calendar-absolute-from-gregorian | 457 | (calendar-absolute-from-gregorian |
| 458 | (list m (calendar-last-day-of-month m y) y))) | 458 | (list m (calendar-last-day-of-month m y) y))) |
| 459 | (calendar-for-loop date from first-date to last-date do | 459 | (calendar-for-loop date from first-date to last-date do |
| 460 | (let* ((b-date (calendar-bahai-from-absolute date)) | 460 | (let* ((b-date (calendar-bahai-from-absolute date)) |
| 461 | (i-month (extract-calendar-month b-date)) | 461 | (i-month (extract-calendar-month b-date)) |
| 462 | (i-day (extract-calendar-day b-date)) | 462 | (i-day (extract-calendar-day b-date)) |
| 463 | (i-year (extract-calendar-year b-date))) | 463 | (i-year (extract-calendar-year b-date))) |
| 464 | (and (or (zerop month) | 464 | (and (or (zerop month) |
| 465 | (= month i-month)) | 465 | (= month i-month)) |
| 466 | (or (zerop day) | 466 | (or (zerop day) |
| 467 | (= day i-day)) | 467 | (= day i-day)) |
| 468 | (or (zerop year) | 468 | (or (zerop year) |
| 469 | (= year i-year)) | 469 | (= year i-year)) |
| 470 | (mark-visible-calendar-date | 470 | (mark-visible-calendar-date |
| 471 | (calendar-gregorian-from-absolute date))))))))) | 471 | (calendar-gregorian-from-absolute |
| 472 | date))))))))) | ||
| 472 | 473 | ||
| 473 | ;;;###cal-autoload | 474 | ;;;###cal-autoload |
| 474 | (defun diary-bahai-insert-entry (arg) | 475 | (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 @@ | |||
| 4 | ;; 2006, 2007, 2008 Free Software Foundation, Inc. | 4 | ;; 2006, 2007, 2008 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Paul Eggert <eggert@twinsun.com> | 6 | ;; Author: Paul Eggert <eggert@twinsun.com> |
| 7 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> | 7 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> |
| 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> | 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
| 9 | ;; Keywords: calendar | 9 | ;; Keywords: calendar |
| 10 | ;; Human-Keywords: daylight saving time, calendar, diary, holidays | 10 | ;; Human-Keywords: daylight saving time, calendar, diary, holidays |
| @@ -113,15 +113,15 @@ high and low 16 bits, respectively, of the number of seconds since | |||
| 113 | Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on | 113 | Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on |
| 114 | absolute date ABS-DATE is the equivalent moment to X." | 114 | absolute date ABS-DATE is the equivalent moment to X." |
| 115 | (let* ((h (car x)) | 115 | (let* ((h (car x)) |
| 116 | (xtail (cdr x)) | 116 | (xtail (cdr x)) |
| 117 | (l (+ utc-diff (if (numberp xtail) xtail (car xtail)))) | 117 | (l (+ utc-diff (if (numberp xtail) xtail (car xtail)))) |
| 118 | (u (+ (* 512 (mod h 675)) (floor l 128)))) | 118 | (u (+ (* 512 (mod h 675)) (floor l 128)))) |
| 119 | ;; Overflow is a terrible thing! | 119 | ;; Overflow is a terrible thing! |
| 120 | (cons (+ calendar-system-time-basis | 120 | (cons (+ calendar-system-time-basis |
| 121 | ;; floor((2^16 h +l) / (60*60*24)) | 121 | ;; floor((2^16 h +l) / (60*60*24)) |
| 122 | (* 512 (floor h 675)) (floor u 675)) | 122 | (* 512 (floor h 675)) (floor u 675)) |
| 123 | ;; (2^16 h +l) mod (60*60*24) | 123 | ;; (2^16 h +l) mod (60*60*24) |
| 124 | (+ (* (mod u 675) 128) (mod l 128))))) | 124 | (+ (* (mod u 675) 128) (mod l 128))))) |
| 125 | 125 | ||
| 126 | (defun calendar-time-from-absolute (abs-date s) | 126 | (defun calendar-time-from-absolute (abs-date s) |
| 127 | "Time of absolute date ABS-DATE, S seconds after midnight. | 127 | "Time of absolute date ABS-DATE, S seconds after midnight. |
| @@ -143,12 +143,12 @@ midnight UTC on absolute date ABS-DATE." | |||
| 143 | "Return the time of the next time zone transition after TIME. | 143 | "Return the time of the next time zone transition after TIME. |
| 144 | Both TIME and the result are acceptable arguments to `current-time-zone'. | 144 | Both TIME and the result are acceptable arguments to `current-time-zone'. |
| 145 | Return nil if no such transition can be found." | 145 | Return nil if no such transition can be found." |
| 146 | (let* ((base 65536);; 2^16 = base of current-time output | 146 | (let* ((base 65536) ;; 2^16 = base of current-time output |
| 147 | (quarter-multiple 120);; approx = (seconds per quarter year) / base | 147 | (quarter-multiple 120) ;; approx = (seconds per quarter year) / base |
| 148 | (time-zone (current-time-zone time)) | 148 | (time-zone (current-time-zone time)) |
| 149 | (time-utc-diff (car time-zone)) | 149 | (time-utc-diff (car time-zone)) |
| 150 | hi | 150 | hi |
| 151 | hi-zone | 151 | hi-zone |
| 152 | (hi-utc-diff time-utc-diff) | 152 | (hi-utc-diff time-utc-diff) |
| 153 | (quarters '(2 1 3))) | 153 | (quarters '(2 1 3))) |
| 154 | ;; Heuristic: probe the time zone offset in the next three calendar | 154 | ;; Heuristic: probe the time zone offset in the next three calendar |
| @@ -166,21 +166,21 @@ Return nil if no such transition can be found." | |||
| 166 | ;; Set LO to TIME, and then binary search to increase LO and decrease HI | 166 | ;; Set LO to TIME, and then binary search to increase LO and decrease HI |
| 167 | ;; until LO is just before and HI is just after the time zone transition. | 167 | ;; until LO is just before and HI is just after the time zone transition. |
| 168 | (let* ((tail (cdr time)) | 168 | (let* ((tail (cdr time)) |
| 169 | (lo (cons (car time) (if (numberp tail) tail (car tail)))) | 169 | (lo (cons (car time) (if (numberp tail) tail (car tail)))) |
| 170 | probe) | 170 | probe) |
| 171 | (while | 171 | (while |
| 172 | ;; Set PROBE to halfway between LO and HI, rounding down. | 172 | ;; Set PROBE to halfway between LO and HI, rounding down. |
| 173 | ;; If PROBE equals LO, we are done. | 173 | ;; If PROBE equals LO, we are done. |
| 174 | (let* ((lsum (+ (cdr lo) (cdr hi))) | 174 | (let* ((lsum (+ (cdr lo) (cdr hi))) |
| 175 | (hsum (+ (car lo) (car hi) (/ lsum base))) | 175 | (hsum (+ (car lo) (car hi) (/ lsum base))) |
| 176 | (hsumodd (logand 1 hsum))) | 176 | (hsumodd (logand 1 hsum))) |
| 177 | (setq probe (cons (/ (- hsum hsumodd) 2) | 177 | (setq probe (cons (/ (- hsum hsumodd) 2) |
| 178 | (/ (+ (* hsumodd base) (% lsum base)) 2))) | 178 | (/ (+ (* hsumodd base) (% lsum base)) 2))) |
| 179 | (not (equal lo probe))) | 179 | (not (equal lo probe))) |
| 180 | ;; Set either LO or HI to PROBE, depending on probe results. | 180 | ;; Set either LO or HI to PROBE, depending on probe results. |
| 181 | (if (eq (car (current-time-zone probe)) hi-utc-diff) | 181 | (if (eq (car (current-time-zone probe)) hi-utc-diff) |
| 182 | (setq hi probe) | 182 | (setq hi probe) |
| 183 | (setq lo probe))) | 183 | (setq lo probe))) |
| 184 | hi)))) | 184 | hi)))) |
| 185 | 185 | ||
| 186 | (defun calendar-time-zone-daylight-rules (abs-date utc-diff) | 186 | (defun calendar-time-zone-daylight-rules (abs-date utc-diff) |
| @@ -188,69 +188,70 @@ Return nil if no such transition can be found." | |||
| 188 | ABS-DATE must specify a day that contains a daylight saving transition. | 188 | ABS-DATE must specify a day that contains a daylight saving transition. |
| 189 | The result has the proper form for `calendar-daylight-savings-starts'." | 189 | The result has the proper form for `calendar-daylight-savings-starts'." |
| 190 | (let* ((date (calendar-gregorian-from-absolute abs-date)) | 190 | (let* ((date (calendar-gregorian-from-absolute abs-date)) |
| 191 | (weekday (% abs-date 7)) | 191 | (weekday (% abs-date 7)) |
| 192 | (m (extract-calendar-month date)) | 192 | (m (extract-calendar-month date)) |
| 193 | (d (extract-calendar-day date)) | 193 | (d (extract-calendar-day date)) |
| 194 | (y (extract-calendar-year date)) | 194 | (y (extract-calendar-year date)) |
| 195 | (last (calendar-last-day-of-month m y)) | 195 | (last (calendar-last-day-of-month m y)) |
| 196 | (candidate-rules | 196 | (candidate-rules |
| 197 | (append | 197 | (append |
| 198 | ;; Day D of month M. | 198 | ;; Day D of month M. |
| 199 | (list (list 'list m d 'year)) | 199 | (list (list 'list m d 'year)) |
| 200 | ;; The first WEEKDAY of month M. | 200 | ;; The first WEEKDAY of month M. |
| 201 | (if (< d 8) | 201 | (if (< d 8) |
| 202 | (list (list 'calendar-nth-named-day 1 weekday m 'year))) | 202 | (list (list 'calendar-nth-named-day 1 weekday m 'year))) |
| 203 | ;; The last WEEKDAY of month M. | 203 | ;; The last WEEKDAY of month M. |
| 204 | (if (> d (- last 7)) | 204 | (if (> d (- last 7)) |
| 205 | (list (list 'calendar-nth-named-day -1 weekday m 'year))) | 205 | (list (list 'calendar-nth-named-day -1 weekday m 'year))) |
| 206 | ;; The first WEEKDAY after day J of month M, for D-6 < J <= D. | 206 | ;; The first WEEKDAY after day J of month M, for D-6 < J <= D. |
| 207 | (let (l) | 207 | (let (l) |
| 208 | (calendar-for-loop j from (max 2 (- d 6)) to (min d (- last 8)) do | 208 | (calendar-for-loop j from (max 2 (- d 6)) to (min d (- last 8)) do |
| 209 | (setq l | 209 | (setq l |
| 210 | (cons | 210 | (cons |
| 211 | (list 'calendar-nth-named-day 1 weekday m 'year j) | 211 | (list 'calendar-nth-named-day |
| 212 | l))) | 212 | 1 weekday m 'year j) |
| 213 | l) | 213 | l))) |
| 214 | ;; 01-01 and 07-01 for this year's Persian calendar. | 214 | l) |
| 215 | (if (and (= m 3) (<= 20 d) (<= d 21)) | 215 | ;; 01-01 and 07-01 for this year's Persian calendar. |
| 216 | '((calendar-gregorian-from-absolute | 216 | (if (and (= m 3) (<= 20 d) (<= d 21)) |
| 217 | (calendar-absolute-from-persian | 217 | '((calendar-gregorian-from-absolute |
| 218 | (list 1 1 (- year 621)))))) | 218 | (calendar-absolute-from-persian |
| 219 | (if (and (= m 9) (<= 22 d) (<= d 23)) | 219 | (list 1 1 (- year 621)))))) |
| 220 | '((calendar-gregorian-from-absolute | 220 | (if (and (= m 9) (<= 22 d) (<= d 23)) |
| 221 | (calendar-absolute-from-persian | 221 | '((calendar-gregorian-from-absolute |
| 222 | (list 7 1 (- year 621)))))))) | 222 | (calendar-absolute-from-persian |
| 223 | (prevday-sec (- -1 utc-diff)) ;; last sec of previous local day | 223 | (list 7 1 (- year 621)))))))) |
| 224 | (year (1+ y))) | 224 | (prevday-sec (- -1 utc-diff)) ;; last sec of previous local day |
| 225 | (year (1+ y))) | ||
| 225 | ;; Scan through the next few years until only one rule remains. | 226 | ;; Scan through the next few years until only one rule remains. |
| 226 | (while | 227 | (while |
| 227 | (let ((rules candidate-rules) | 228 | (let ((rules candidate-rules) |
| 228 | new-rules) | 229 | new-rules) |
| 229 | (while | 230 | (while |
| 230 | (let* | 231 | (let* |
| 231 | ((rule (car rules)) | 232 | ((rule (car rules)) |
| 232 | (date | 233 | (date |
| 233 | ;; The following is much faster than | 234 | ;; The following is much faster than |
| 234 | ;; (calendar-absolute-from-gregorian (eval rule)). | 235 | ;; (calendar-absolute-from-gregorian (eval rule)). |
| 235 | (cond ((eq (car rule) 'calendar-nth-named-day) | 236 | (cond ((eq (car rule) 'calendar-nth-named-day) |
| 236 | (eval (cons 'calendar-nth-named-absday (cdr rule)))) | 237 | (eval (cons 'calendar-nth-named-absday (cdr rule)))) |
| 237 | ((eq (car rule) 'calendar-gregorian-from-absolute) | 238 | ((eq (car rule) 'calendar-gregorian-from-absolute) |
| 238 | (eval (car (cdr rule)))) | 239 | (eval (car (cdr rule)))) |
| 239 | (t (let ((g (eval rule))) | 240 | (t (let ((g (eval rule))) |
| 240 | (calendar-absolute-from-gregorian g)))))) | 241 | (calendar-absolute-from-gregorian g)))))) |
| 241 | (or (equal | 242 | (or (equal |
| 242 | (current-time-zone | 243 | (current-time-zone |
| 243 | (calendar-time-from-absolute date prevday-sec)) | 244 | (calendar-time-from-absolute date prevday-sec)) |
| 244 | (current-time-zone | 245 | (current-time-zone |
| 245 | (calendar-time-from-absolute (1+ date) prevday-sec))) | 246 | (calendar-time-from-absolute (1+ date) prevday-sec))) |
| 246 | (setq new-rules (cons rule new-rules))) | 247 | (setq new-rules (cons rule new-rules))) |
| 247 | (setq rules (cdr rules)))) | 248 | (setq rules (cdr rules)))) |
| 248 | ;; If no rules remain, just use the first candidate rule; | 249 | ;; If no rules remain, just use the first candidate rule; |
| 249 | ;; it's wrong in general, but it's right for at least one year. | 250 | ;; it's wrong in general, but it's right for at least one year. |
| 250 | (setq candidate-rules (if new-rules (nreverse new-rules) | 251 | (setq candidate-rules (if new-rules (nreverse new-rules) |
| 251 | (list (car candidate-rules)))) | 252 | (list (car candidate-rules)))) |
| 252 | (setq year (1+ year)) | 253 | (setq year (1+ year)) |
| 253 | (cdr candidate-rules))) | 254 | (cdr candidate-rules))) |
| 254 | (car candidate-rules))) | 255 | (car candidate-rules))) |
| 255 | 256 | ||
| 256 | ;; TODO it might be better to extract this information directly from | 257 | ;; 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'." | |||
| 414 | (cadr (calendar-dst-find-startend year)) | 415 | (cadr (calendar-dst-find-startend year)) |
| 415 | (nth 4 calendar-current-time-zone-cache)))) | 416 | (nth 4 calendar-current-time-zone-cache)))) |
| 416 | (if expr (eval expr))) | 417 | (if expr (eval expr))) |
| 417 | ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. | 418 | ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. |
| 418 | (and (not (zerop calendar-daylight-time-offset)) | 419 | (and (not (zerop calendar-daylight-time-offset)) |
| 419 | (calendar-nth-named-day 2 0 3 year)))) | 420 | (calendar-nth-named-day 2 0 3 year)))) |
| 420 | 421 | ||
| @@ -425,7 +426,7 @@ This function respects the value of `calendar-dst-check-each-year-flag'." | |||
| 425 | (nth 2 (calendar-dst-find-startend year)) | 426 | (nth 2 (calendar-dst-find-startend year)) |
| 426 | (nth 5 calendar-current-time-zone-cache)))) | 427 | (nth 5 calendar-current-time-zone-cache)))) |
| 427 | (if expr (eval expr))) | 428 | (if expr (eval expr))) |
| 428 | ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. | 429 | ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. |
| 429 | (and (not (zerop calendar-daylight-time-offset)) | 430 | (and (not (zerop calendar-daylight-time-offset)) |
| 430 | (calendar-nth-named-day 1 0 11 year)))) | 431 | (calendar-nth-named-day 1 0 11 year)))) |
| 431 | 432 | ||
| @@ -469,12 +470,12 @@ Conversion to daylight saving time is done according to | |||
| 469 | `calendar-daylight-savings-offset'." | 470 | `calendar-daylight-savings-offset'." |
| 470 | 471 | ||
| 471 | (let* ((rounded-abs-date (+ (calendar-absolute-from-gregorian date) | 472 | (let* ((rounded-abs-date (+ (calendar-absolute-from-gregorian date) |
| 472 | (/ (round (* 60 time)) 60.0 24.0))) | 473 | (/ (round (* 60 time)) 60.0 24.0))) |
| 473 | (dst (dst-in-effect rounded-abs-date)) | 474 | (dst (dst-in-effect rounded-abs-date)) |
| 474 | (time-zone (if dst | 475 | (time-zone (if dst |
| 475 | calendar-daylight-time-zone-name | 476 | calendar-daylight-time-zone-name |
| 476 | calendar-standard-time-zone-name)) | 477 | calendar-standard-time-zone-name)) |
| 477 | (time (+ rounded-abs-date | 478 | (time (+ rounded-abs-date |
| 478 | (if dst (/ calendar-daylight-time-offset 24.0 60.0) 0)))) | 479 | (if dst (/ calendar-daylight-time-offset 24.0 60.0) 0)))) |
| 479 | (list (calendar-gregorian-from-absolute (truncate time)) | 480 | (list (calendar-gregorian-from-absolute (truncate time)) |
| 480 | (* 24.0 (- time (truncate time))) | 481 | (* 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 @@ | |||
| 44 | (defun french-calendar-accents () | 44 | (defun french-calendar-accents () |
| 45 | "True if diacritical marks are available." | 45 | "True if diacritical marks are available." |
| 46 | (and (or window-system | 46 | (and (or window-system |
| 47 | (terminal-coding-system)) | 47 | (terminal-coding-system)) |
| 48 | (or enable-multibyte-characters | 48 | (or enable-multibyte-characters |
| 49 | (and (char-table-p standard-display-table) | 49 | (and (char-table-p standard-display-table) |
| 50 | (equal (aref standard-display-table 161) [161]))))) | 50 | (equal (aref standard-display-table 161) [161]))))) |
| 51 | 51 | ||
| 52 | (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) | 52 | (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) |
| 53 | "Absolute date of start of French Revolutionary calendar = September 22, 1792.") | 53 | "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 | |||
| 145 | (year ; search forward from the approximation | 145 | (year ; search forward from the approximation |
| 146 | (+ approx | 146 | (+ approx |
| 147 | (calendar-sum y approx | 147 | (calendar-sum y approx |
| 148 | (>= date (calendar-absolute-from-french (list 1 1 (1+ y)))) | 148 | (>= date (calendar-absolute-from-french |
| 149 | 1))) | 149 | (list 1 1 (1+ y)))) |
| 150 | 1))) | ||
| 150 | (month ; search forward from Vendemiaire | 151 | (month ; search forward from Vendemiaire |
| 151 | (1+ (calendar-sum m 1 | 152 | (1+ (calendar-sum m 1 |
| 152 | (> date | 153 | (> date |
| 153 | (calendar-absolute-from-french | 154 | (calendar-absolute-from-french |
| 154 | (list m | 155 | (list m |
| 155 | (french-calendar-last-day-of-month m year) | 156 | (french-calendar-last-day-of-month |
| 156 | year))) | 157 | m year) |
| 157 | 1))) | 158 | year))) |
| 159 | 1))) | ||
| 158 | (day ; calculate the day by subtraction | 160 | (day ; calculate the day by subtraction |
| 159 | (- date | 161 | (- date |
| 160 | (1- (calendar-absolute-from-french (list month 1 year)))))) | 162 | (1- (calendar-absolute-from-french (list month 1 year)))))) |
| 161 | (list month day year)))) | 163 | (list month day year)))) |
| 162 | 164 | ||
| 163 | ;;;###cal-autoload | 165 | ;;;###cal-autoload |
| 164 | (defun calendar-french-date-string (&optional date) | 166 | (defun calendar-french-date-string (&optional date) |
| @@ -201,47 +203,47 @@ Defaults to today's date if DATE is not given." | |||
| 201 | Echo French Revolutionary date unless NOECHO is t." | 203 | Echo French Revolutionary date unless NOECHO is t." |
| 202 | (interactive | 204 | (interactive |
| 203 | (let ((accents (french-calendar-accents)) | 205 | (let ((accents (french-calendar-accents)) |
| 204 | (months (french-calendar-month-name-array)) | 206 | (months (french-calendar-month-name-array)) |
| 205 | (special-days (french-calendar-special-days-array))) | 207 | (special-days (french-calendar-special-days-array))) |
| 206 | (let* ((year | 208 | (let* ((year |
| 207 | (progn | 209 | (progn |
| 208 | (calendar-read | 210 | (calendar-read |
| 209 | (if accents | 211 | (if accents |
| 210 | "Année de la Révolution (>0): " | 212 | "Année de la Révolution (>0): " |
| 211 | "Anne'e de la Re'volution (>0): ") | 213 | "Anne'e de la Re'volution (>0): ") |
| 212 | (lambda (x) (> x 0)) | 214 | (lambda (x) (> x 0)) |
| 213 | (int-to-string | 215 | (int-to-string |
| 214 | (extract-calendar-year | 216 | (extract-calendar-year |
| 215 | (calendar-french-from-absolute | 217 | (calendar-french-from-absolute |
| 216 | (calendar-absolute-from-gregorian | 218 | (calendar-absolute-from-gregorian |
| 217 | (calendar-current-date)))))))) | 219 | (calendar-current-date)))))))) |
| 218 | (month-list | 220 | (month-list |
| 219 | (mapcar 'list | 221 | (mapcar 'list |
| 220 | (append months | 222 | (append months |
| 221 | (if (french-calendar-leap-year-p year) | 223 | (if (french-calendar-leap-year-p year) |
| 222 | (mapcar | 224 | (mapcar |
| 223 | (lambda (x) (concat "Jour " x)) | 225 | (lambda (x) (concat "Jour " x)) |
| 224 | french-calendar-special-days-array) | 226 | french-calendar-special-days-array) |
| 225 | (reverse | 227 | (reverse |
| 226 | (cdr ; we don't want rev. day in a non-leap yr | 228 | (cdr ; we don't want rev. day in a non-leap yr |
| 227 | (reverse | 229 | (reverse |
| 228 | (mapcar | 230 | (mapcar |
| 229 | (lambda (x) | 231 | (lambda (x) |
| 230 | (concat "Jour " x)) | 232 | (concat "Jour " x)) |
| 231 | special-days)))))))) | 233 | special-days)))))))) |
| 232 | (completion-ignore-case t) | 234 | (completion-ignore-case t) |
| 233 | (month (cdr (assoc-string | 235 | (month (cdr (assoc-string |
| 234 | (completing-read | 236 | (completing-read |
| 235 | "Mois ou Sansculottide: " | 237 | "Mois ou Sansculottide: " |
| 236 | month-list | 238 | month-list |
| 237 | nil t) | 239 | nil t) |
| 238 | (calendar-make-alist month-list 1 'car) t))) | 240 | (calendar-make-alist month-list 1 'car) t))) |
| 239 | (day (if (> month 12) | 241 | (day (if (> month 12) |
| 240 | (- month 12) | 242 | (- month 12) |
| 241 | (calendar-read | 243 | (calendar-read |
| 242 | "Jour (1-30): " | 244 | "Jour (1-30): " |
| 243 | (lambda (x) (and (<= 1 x) (<= x 30)))))) | 245 | (lambda (x) (and (<= 1 x) (<= x 30)))))) |
| 244 | (month (if (> month 12) 13 month))) | 246 | (month (if (> month 12) 13 month))) |
| 245 | (list (list month day year))))) | 247 | (list (list month day year))))) |
| 246 | (calendar-goto-date (calendar-gregorian-from-absolute | 248 | (calendar-goto-date (calendar-gregorian-from-absolute |
| 247 | (calendar-absolute-from-french date))) | 249 | (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 @@ | |||
| 64 | (* 12 months-elapsed) | 64 | (* 12 months-elapsed) |
| 65 | (* 793 (/ months-elapsed 1080)) | 65 | (* 793 (/ months-elapsed 1080)) |
| 66 | (/ parts-elapsed 1080))) | 66 | (/ parts-elapsed 1080))) |
| 67 | (parts ; conjunction parts | 67 | (parts ; conjunction parts |
| 68 | (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080))) | 68 | (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080))) |
| 69 | (day ; conjunction day | 69 | (day ; conjunction day |
| 70 | (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24))) | 70 | (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24))) |
| 71 | (alternative-day | 71 | (alternative-day |
| 72 | (if (or (>= parts 19440) ; if the new moon is at or after midday | 72 | (if (or (>= parts 19440) ; if the new moon is at or after midday |
| 73 | (and (= (% day 7) 2) ; ...or is on a Tuesday... | 73 | (and (= (% day 7) 2) ; ...or is on a Tuesday... |
| 74 | (>= parts 9924) ; at 9 hours, 204 parts or later... | 74 | (>= parts 9924) ; at 9 hours, 204 parts or later... |
| 75 | ;; of a common year... | 75 | ;; of a common year... |
| 76 | (not (hebrew-calendar-leap-year-p year))) | 76 | (not (hebrew-calendar-leap-year-p year))) |
| 77 | (and (= (% day 7) 1) ; ...or is on a Monday... | 77 | (and (= (% day 7) 1) ; ...or is on a Monday... |
| 78 | (>= parts 16789) ; at 15 hours, 589 parts or later... | 78 | (>= parts 16789) ; at 15 hours, 589 parts or later... |
| 79 | ;; at the end of a leap year. | 79 | ;; at the end of a leap year. |
| 80 | (hebrew-calendar-leap-year-p (1- year)))) | 80 | (hebrew-calendar-leap-year-p (1- year)))) |
| 81 | ;; Then postpone Rosh HaShanah one day. | 81 | ;; Then postpone Rosh HaShanah one day. |
| 82 | (1+ day) | 82 | (1+ day) |
| 83 | ;; Else: | 83 | ;; Else: |
| 84 | day))) | 84 | day))) |
| 85 | ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday | 85 | ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday |
| 86 | (if (memq (% alternative-day 7) (list 0 3 5)) | 86 | (if (memq (% alternative-day 7) (list 0 3 5)) |
| 87 | ;; Then postpone it one (more) day and return. | 87 | ;; Then postpone it one (more) day and return. |
| 88 | (1+ alternative-day) | 88 | (1+ alternative-day) |
| 89 | ;; Else return. | 89 | ;; Else return. |
| 90 | alternative-day))) | 90 | alternative-day))) |
| @@ -118,21 +118,21 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 118 | (let* ((month (extract-calendar-month date)) | 118 | (let* ((month (extract-calendar-month date)) |
| 119 | (day (extract-calendar-day date)) | 119 | (day (extract-calendar-day date)) |
| 120 | (year (extract-calendar-year date))) | 120 | (year (extract-calendar-year date))) |
| 121 | (+ day ; days so far this month | 121 | (+ day ; days so far this month |
| 122 | (if (< month 7) ; before Tishri | 122 | (if (< month 7) ; before Tishri |
| 123 | ;; Then add days in prior months this year before and after Nisan. | 123 | ;; Then add days in prior months this year before and after Nisan. |
| 124 | (+ (calendar-sum | 124 | (+ (calendar-sum |
| 125 | m 7 (<= m (hebrew-calendar-last-month-of-year year)) | 125 | m 7 (<= m (hebrew-calendar-last-month-of-year year)) |
| 126 | (hebrew-calendar-last-day-of-month m year)) | 126 | (hebrew-calendar-last-day-of-month m year)) |
| 127 | (calendar-sum | 127 | (calendar-sum |
| 128 | m 1 (< m month) | 128 | m 1 (< m month) |
| 129 | (hebrew-calendar-last-day-of-month m year))) | 129 | (hebrew-calendar-last-day-of-month m year))) |
| 130 | ;; Else add days in prior months this year. | 130 | ;; Else add days in prior months this year. |
| 131 | (calendar-sum | 131 | (calendar-sum |
| 132 | m 7 (< m month) | 132 | m 7 (< m month) |
| 133 | (hebrew-calendar-last-day-of-month m year))) | 133 | (hebrew-calendar-last-day-of-month m year))) |
| 134 | (hebrew-calendar-elapsed-days year) ; days in prior years | 134 | (hebrew-calendar-elapsed-days year) ; days in prior years |
| 135 | -1373429))) ; days elapsed before absolute date 1 | 135 | -1373429))) ; days elapsed before absolute date 1 |
| 136 | 136 | ||
| 137 | (defun calendar-hebrew-from-absolute (date) | 137 | (defun calendar-hebrew-from-absolute (date) |
| 138 | "Compute the Hebrew date (month day year) corresponding to absolute DATE. | 138 | "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) | |||
| 140 | Gregorian date Sunday, December 31, 1 BC." | 140 | Gregorian date Sunday, December 31, 1 BC." |
| 141 | (let* ((greg-date (calendar-gregorian-from-absolute date)) | 141 | (let* ((greg-date (calendar-gregorian-from-absolute date)) |
| 142 | (month (aref [9 10 11 12 1 2 3 4 7 7 7 8] | 142 | (month (aref [9 10 11 12 1 2 3 4 7 7 7 8] |
| 143 | (1- (extract-calendar-month greg-date)))) | 143 | (1- (extract-calendar-month greg-date)))) |
| 144 | (day) | 144 | (day) |
| 145 | (year (+ 3760 (extract-calendar-year greg-date)))) | 145 | (year (+ 3760 (extract-calendar-year greg-date)))) |
| 146 | (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year)))) | 146 | (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year)))) |
| 147 | (setq year (1+ year))) | 147 | (setq year (1+ year))) |
| 148 | (let ((length (hebrew-calendar-last-month-of-year year))) | 148 | (let ((length (hebrew-calendar-last-month-of-year year))) |
| 149 | (while (> date | 149 | (while (> date |
| 150 | (calendar-absolute-from-hebrew | 150 | (calendar-absolute-from-hebrew |
| @@ -159,12 +159,12 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 159 | (defvar calendar-hebrew-month-name-array-common-year | 159 | (defvar calendar-hebrew-month-name-array-common-year |
| 160 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" | 160 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" |
| 161 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"] | 161 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"] |
| 162 | "Array of strings giving the names of the Hebrew months in a common year.") | 162 | "Array of strings giving the names of the Hebrew months in a common year.") |
| 163 | 163 | ||
| 164 | (defvar calendar-hebrew-month-name-array-leap-year | 164 | (defvar calendar-hebrew-month-name-array-leap-year |
| 165 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" | 165 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" |
| 166 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"] | 166 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"] |
| 167 | "Array of strings giving the names of the Hebrew months in a leap year.") | 167 | "Array of strings giving the names of the Hebrew months in a leap year.") |
| 168 | 168 | ||
| 169 | ;;;###cal-autoload | 169 | ;;;###cal-autoload |
| 170 | (defun calendar-hebrew-date-string (&optional date) | 170 | (defun calendar-hebrew-date-string (&optional date) |
| @@ -242,17 +242,17 @@ Driven by the variable `calendar-date-display-form'." | |||
| 242 | (mapcar 'list (append month-array nil)) | 242 | (mapcar 'list (append month-array nil)) |
| 243 | (if (= year 3761) | 243 | (if (= year 3761) |
| 244 | (lambda (x) | 244 | (lambda (x) |
| 245 | (let ((m (cdr | 245 | (let ((m (cdr |
| 246 | (assoc-string | 246 | (assoc-string |
| 247 | (car x) | 247 | (car x) |
| 248 | (calendar-make-alist month-array) | 248 | (calendar-make-alist month-array) |
| 249 | t)))) | 249 | t)))) |
| 250 | (< 0 | 250 | (< 0 |
| 251 | (calendar-absolute-from-hebrew | 251 | (calendar-absolute-from-hebrew |
| 252 | (list m | 252 | (list m |
| 253 | (hebrew-calendar-last-day-of-month | 253 | (hebrew-calendar-last-day-of-month |
| 254 | m year) | 254 | m year) |
| 255 | year)))))) | 255 | year)))))) |
| 256 | t) | 256 | t) |
| 257 | (calendar-make-alist month-array 1) t))) | 257 | (calendar-make-alist month-array 1) t))) |
| 258 | (last (hebrew-calendar-last-day-of-month month year)) | 258 | (last (hebrew-calendar-last-day-of-month month year)) |
| @@ -311,21 +311,21 @@ nil if it is not visible in the current calendar window." | |||
| 311 | "List of dates related to Rosh Hashanah, as visible in calendar window." | 311 | "List of dates related to Rosh Hashanah, as visible in calendar window." |
| 312 | (if (or (< displayed-month 8) | 312 | (if (or (< displayed-month 8) |
| 313 | (> displayed-month 11)) | 313 | (> displayed-month 11)) |
| 314 | nil ; none of the dates is visible | 314 | nil ; none of the dates is visible |
| 315 | (let* ((abs-r-h (calendar-absolute-from-hebrew | 315 | (let* ((abs-r-h (calendar-absolute-from-hebrew |
| 316 | (list 7 1 (+ displayed-year 3761)))) | 316 | (list 7 1 (+ displayed-year 3761)))) |
| 317 | (mandatory | 317 | (mandatory |
| 318 | (list | 318 | (list |
| 319 | (list (calendar-gregorian-from-absolute abs-r-h) | 319 | (list (calendar-gregorian-from-absolute abs-r-h) |
| 320 | (format "Rosh HaShanah %d" (+ 3761 displayed-year))) | 320 | (format "Rosh HaShanah %d" (+ 3761 displayed-year))) |
| 321 | (list (calendar-gregorian-from-absolute (+ abs-r-h 9)) | 321 | (list (calendar-gregorian-from-absolute (+ abs-r-h 9)) |
| 322 | "Yom Kippur") | 322 | "Yom Kippur") |
| 323 | (list (calendar-gregorian-from-absolute (+ abs-r-h 14)) | 323 | (list (calendar-gregorian-from-absolute (+ abs-r-h 14)) |
| 324 | "Sukkot") | 324 | "Sukkot") |
| 325 | (list (calendar-gregorian-from-absolute (+ abs-r-h 21)) | 325 | (list (calendar-gregorian-from-absolute (+ abs-r-h 21)) |
| 326 | "Shemini Atzeret") | 326 | "Shemini Atzeret") |
| 327 | (list (calendar-gregorian-from-absolute (+ abs-r-h 22)) | 327 | (list (calendar-gregorian-from-absolute (+ abs-r-h 22)) |
| 328 | "Simchat Torah"))) | 328 | "Simchat Torah"))) |
| 329 | (optional | 329 | (optional |
| 330 | (list | 330 | (list |
| 331 | (list (calendar-gregorian-from-absolute | 331 | (list (calendar-gregorian-from-absolute |
| @@ -357,8 +357,8 @@ nil if it is not visible in the current calendar window." | |||
| 357 | "Hol Hamoed Sukkot (fourth day)") | 357 | "Hol Hamoed Sukkot (fourth day)") |
| 358 | (list (calendar-gregorian-from-absolute (+ abs-r-h 20)) | 358 | (list (calendar-gregorian-from-absolute (+ abs-r-h 20)) |
| 359 | "Hoshanah Rabbah"))) | 359 | "Hoshanah Rabbah"))) |
| 360 | (output-list | 360 | (output-list |
| 361 | (holiday-filter-visible-calendar mandatory))) | 361 | (holiday-filter-visible-calendar mandatory))) |
| 362 | (if all-hebrew-calendar-holidays | 362 | (if all-hebrew-calendar-holidays |
| 363 | (setq output-list | 363 | (setq output-list |
| 364 | (append | 364 | (append |
| @@ -371,43 +371,43 @@ nil if it is not visible in the current calendar window." | |||
| 371 | "List of dates related to Hanukkah, as visible in calendar window." | 371 | "List of dates related to Hanukkah, as visible in calendar window." |
| 372 | ;; This test is only to speed things up a bit, it works fine without it. | 372 | ;; This test is only to speed things up a bit, it works fine without it. |
| 373 | (if (memq displayed-month | 373 | (if (memq displayed-month |
| 374 | '(10 11 12 1 2)) | 374 | '(10 11 12 1 2)) |
| 375 | (let ((m displayed-month) | 375 | (let ((m displayed-month) |
| 376 | (y displayed-year)) | 376 | (y displayed-year)) |
| 377 | (increment-calendar-month m y 1) | 377 | (increment-calendar-month m y 1) |
| 378 | (let* ((h-y (extract-calendar-year | 378 | (let* ((h-y (extract-calendar-year |
| 379 | (calendar-hebrew-from-absolute | 379 | (calendar-hebrew-from-absolute |
| 380 | (calendar-absolute-from-gregorian | 380 | (calendar-absolute-from-gregorian |
| 381 | (list m (calendar-last-day-of-month m y) y))))) | 381 | (list m (calendar-last-day-of-month m y) y))))) |
| 382 | (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) | 382 | (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) |
| 383 | (holiday-filter-visible-calendar | 383 | (holiday-filter-visible-calendar |
| 384 | (list | 384 | (list |
| 385 | (list (calendar-gregorian-from-absolute (1- abs-h)) | 385 | (list (calendar-gregorian-from-absolute (1- abs-h)) |
| 386 | "Erev Hanukkah") | 386 | "Erev Hanukkah") |
| 387 | (list (calendar-gregorian-from-absolute abs-h) | 387 | (list (calendar-gregorian-from-absolute abs-h) |
| 388 | "Hanukkah (first day)") | 388 | "Hanukkah (first day)") |
| 389 | (list (calendar-gregorian-from-absolute (1+ abs-h)) | 389 | (list (calendar-gregorian-from-absolute (1+ abs-h)) |
| 390 | "Hanukkah (second day)") | 390 | "Hanukkah (second day)") |
| 391 | (list (calendar-gregorian-from-absolute (+ abs-h 2)) | 391 | (list (calendar-gregorian-from-absolute (+ abs-h 2)) |
| 392 | "Hanukkah (third day)") | 392 | "Hanukkah (third day)") |
| 393 | (list (calendar-gregorian-from-absolute (+ abs-h 3)) | 393 | (list (calendar-gregorian-from-absolute (+ abs-h 3)) |
| 394 | "Hanukkah (fourth day)") | 394 | "Hanukkah (fourth day)") |
| 395 | (list (calendar-gregorian-from-absolute (+ abs-h 4)) | 395 | (list (calendar-gregorian-from-absolute (+ abs-h 4)) |
| 396 | "Hanukkah (fifth day)") | 396 | "Hanukkah (fifth day)") |
| 397 | (list (calendar-gregorian-from-absolute (+ abs-h 5)) | 397 | (list (calendar-gregorian-from-absolute (+ abs-h 5)) |
| 398 | "Hanukkah (sixth day)") | 398 | "Hanukkah (sixth day)") |
| 399 | (list (calendar-gregorian-from-absolute (+ abs-h 6)) | 399 | (list (calendar-gregorian-from-absolute (+ abs-h 6)) |
| 400 | "Hanukkah (seventh day)") | 400 | "Hanukkah (seventh day)") |
| 401 | (list (calendar-gregorian-from-absolute (+ abs-h 7)) | 401 | (list (calendar-gregorian-from-absolute (+ abs-h 7)) |
| 402 | "Hanukkah (eighth day)"))))))) | 402 | "Hanukkah (eighth day)"))))))) |
| 403 | 403 | ||
| 404 | ;;;###holiday-autoload | 404 | ;;;###holiday-autoload |
| 405 | (defun holiday-passover-etc () | 405 | (defun holiday-passover-etc () |
| 406 | "List of dates related to Passover, as visible in calendar window." | 406 | "List of dates related to Passover, as visible in calendar window." |
| 407 | (if (< 7 displayed-month) | 407 | (if (< 7 displayed-month) |
| 408 | nil ; none of the dates is visible | 408 | nil ; none of the dates is visible |
| 409 | (let* ((abs-p (calendar-absolute-from-hebrew | 409 | (let* ((abs-p (calendar-absolute-from-hebrew |
| 410 | (list 1 15 (+ displayed-year 3760)))) | 410 | (list 1 15 (+ displayed-year 3760)))) |
| 411 | (mandatory | 411 | (mandatory |
| 412 | (list | 412 | (list |
| 413 | (list (calendar-gregorian-from-absolute abs-p) | 413 | (list (calendar-gregorian-from-absolute abs-p) |
| @@ -478,7 +478,7 @@ nil if it is not visible in the current calendar window." | |||
| 478 | (list (calendar-gregorian-from-absolute (+ abs-p 51)) | 478 | (list (calendar-gregorian-from-absolute (+ abs-p 51)) |
| 479 | "Shavuot (second day)"))) | 479 | "Shavuot (second day)"))) |
| 480 | (output-list | 480 | (output-list |
| 481 | (holiday-filter-visible-calendar mandatory))) | 481 | (holiday-filter-visible-calendar mandatory))) |
| 482 | (if all-hebrew-calendar-holidays | 482 | (if all-hebrew-calendar-holidays |
| 483 | (setq output-list | 483 | (setq output-list |
| 484 | (append | 484 | (append |
| @@ -491,9 +491,9 @@ nil if it is not visible in the current calendar window." | |||
| 491 | "List of dates around Tisha B'Av, as visible in calendar window." | 491 | "List of dates around Tisha B'Av, as visible in calendar window." |
| 492 | (if (or (< displayed-month 5) | 492 | (if (or (< displayed-month 5) |
| 493 | (> displayed-month 9)) | 493 | (> displayed-month 9)) |
| 494 | nil ; none of the dates is visible | 494 | nil ; none of the dates is visible |
| 495 | (let* ((abs-t-a (calendar-absolute-from-hebrew | 495 | (let* ((abs-t-a (calendar-absolute-from-hebrew |
| 496 | (list 5 9 (+ displayed-year 3760))))) | 496 | (list 5 9 (+ displayed-year 3760))))) |
| 497 | 497 | ||
| 498 | (holiday-filter-visible-calendar | 498 | (holiday-filter-visible-calendar |
| 499 | (list | 499 | (list |
| @@ -514,7 +514,7 @@ nil if it is not visible in the current calendar window." | |||
| 514 | (declare-function add-to-diary-list "diary-lib" | 514 | (declare-function add-to-diary-list "diary-lib" |
| 515 | (date string specifier &optional marker globcolor literal)) | 515 | (date string specifier &optional marker globcolor literal)) |
| 516 | 516 | ||
| 517 | (defvar number) ; from diary-list-entries | 517 | (defvar number) ; from diary-list-entries |
| 518 | 518 | ||
| 519 | ;;;###diary-autoload | 519 | ;;;###diary-autoload |
| 520 | (defun list-hebrew-diary-entries () | 520 | (defun list-hebrew-diary-entries () |
| @@ -619,8 +619,8 @@ A value of 0 in any position is a wildcard." | |||
| 619 | (if (calendar-date-is-visible-p date) | 619 | (if (calendar-date-is-visible-p date) |
| 620 | (mark-visible-calendar-date date))) | 620 | (mark-visible-calendar-date date))) |
| 621 | ;; Month and day in any year--this taken from the holiday stuff. | 621 | ;; Month and day in any year--this taken from the holiday stuff. |
| 622 | ;; This test is only to speed things up a bit, it works | 622 | ;; This test is only to speed things up a bit, it works |
| 623 | ;; fine without it. | 623 | ;; fine without it. |
| 624 | (if (memq displayed-month | 624 | (if (memq displayed-month |
| 625 | (list | 625 | (list |
| 626 | (if (< 11 month) (- month 11) (+ month 1)) | 626 | (if (< 11 month) (- month 11) (+ month 1)) |
| @@ -668,18 +668,19 @@ A value of 0 in any position is a wildcard." | |||
| 668 | (calendar-absolute-from-gregorian | 668 | (calendar-absolute-from-gregorian |
| 669 | (list m (calendar-last-day-of-month m y) y))) | 669 | (list m (calendar-last-day-of-month m y) y))) |
| 670 | (calendar-for-loop date from first-date to last-date do | 670 | (calendar-for-loop date from first-date to last-date do |
| 671 | (let* ((h-date (calendar-hebrew-from-absolute date)) | 671 | (let* ((h-date (calendar-hebrew-from-absolute date)) |
| 672 | (h-month (extract-calendar-month h-date)) | 672 | (h-month (extract-calendar-month h-date)) |
| 673 | (h-day (extract-calendar-day h-date)) | 673 | (h-day (extract-calendar-day h-date)) |
| 674 | (h-year (extract-calendar-year h-date))) | 674 | (h-year (extract-calendar-year h-date))) |
| 675 | (and (or (zerop month) | 675 | (and (or (zerop month) |
| 676 | (= month h-month)) | 676 | (= month h-month)) |
| 677 | (or (zerop day) | 677 | (or (zerop day) |
| 678 | (= day h-day)) | 678 | (= day h-day)) |
| 679 | (or (zerop year) | 679 | (or (zerop year) |
| 680 | (= year h-year)) | 680 | (= year h-year)) |
| 681 | (mark-visible-calendar-date | 681 | (mark-visible-calendar-date |
| 682 | (calendar-gregorian-from-absolute date))))))))) | 682 | (calendar-gregorian-from-absolute date))))) |
| 683 | )))) | ||
| 683 | 684 | ||
| 684 | (declare-function diary-name-pattern "diary-lib" | 685 | (declare-function diary-name-pattern "diary-lib" |
| 685 | (string-array &optional abbrev-array paren)) | 686 | (string-array &optional abbrev-array paren)) |
| @@ -704,7 +705,7 @@ is provided for use as part of `nongregorian-diary-marking-hook'." | |||
| 704 | (let* | 705 | (let* |
| 705 | ((date-form (if (equal (car (car d)) 'backup) | 706 | ((date-form (if (equal (car (car d)) 'backup) |
| 706 | (cdr (car d)) | 707 | (cdr (car d)) |
| 707 | (car d))) ; ignore 'backup directive | 708 | (car d))) ; ignore 'backup directive |
| 708 | (dayname (diary-name-pattern calendar-day-name-array | 709 | (dayname (diary-name-pattern calendar-day-name-array |
| 709 | calendar-day-abbrev-array)) | 710 | calendar-day-abbrev-array)) |
| 710 | (monthname | 711 | (monthname |
| @@ -781,9 +782,9 @@ is provided for use as part of `nongregorian-diary-marking-hook'." | |||
| 781 | (if dd-name | 782 | (if dd-name |
| 782 | (mark-calendar-days-named | 783 | (mark-calendar-days-named |
| 783 | (cdr (assoc-string dd-name | 784 | (cdr (assoc-string dd-name |
| 784 | (calendar-make-alist | 785 | (calendar-make-alist |
| 785 | calendar-day-name-array | 786 | calendar-day-name-array |
| 786 | 0 nil calendar-day-abbrev-array) t))) | 787 | 0 nil calendar-day-abbrev-array) t))) |
| 787 | (if mm-name | 788 | (if mm-name |
| 788 | (setq mm | 789 | (setq mm |
| 789 | (if (string-equal mm-name "*") 0 | 790 | (if (string-equal mm-name "*") 0 |
| @@ -889,8 +890,8 @@ from the cursor position." | |||
| 889 | (end-year (calendar-read | 890 | (end-year (calendar-read |
| 890 | (format "Ending year of Yahrzeit table (>=%d): " | 891 | (format "Ending year of Yahrzeit table (>=%d): " |
| 891 | start-year) | 892 | start-year) |
| 892 | (lambda (x) (>= x start-year))))) | 893 | (lambda (x) (>= x start-year))))) |
| 893 | (list death-date start-year end-year))) | 894 | (list death-date start-year end-year))) |
| 894 | (message "Computing Yahrzeits...") | 895 | (message "Computing Yahrzeits...") |
| 895 | (let* ((h-date (calendar-hebrew-from-absolute | 896 | (let* ((h-date (calendar-hebrew-from-absolute |
| 896 | (calendar-absolute-from-gregorian death-date))) | 897 | (calendar-absolute-from-gregorian death-date))) |
| @@ -910,14 +911,15 @@ from the cursor position." | |||
| 910 | (erase-buffer) | 911 | (erase-buffer) |
| 911 | (goto-char (point-min)) | 912 | (goto-char (point-min)) |
| 912 | (calendar-for-loop i from start-year to end-year do | 913 | (calendar-for-loop i from start-year to end-year do |
| 913 | (insert | 914 | (insert |
| 914 | (calendar-date-string | 915 | (calendar-date-string |
| 915 | (calendar-gregorian-from-absolute | 916 | (calendar-gregorian-from-absolute |
| 916 | (hebrew-calendar-yahrzeit | 917 | (hebrew-calendar-yahrzeit |
| 917 | h-date | 918 | h-date |
| 918 | (extract-calendar-year | 919 | (extract-calendar-year |
| 919 | (calendar-hebrew-from-absolute | 920 | (calendar-hebrew-from-absolute |
| 920 | (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n")) | 921 | (calendar-absolute-from-gregorian |
| 922 | (list 1 1 i))))))) "\n")) | ||
| 921 | (goto-char (point-min)) | 923 | (goto-char (point-min)) |
| 922 | (set-buffer-modified-p nil) | 924 | (set-buffer-modified-p nil) |
| 923 | (setq buffer-read-only t) | 925 | (setq buffer-read-only t) |
| @@ -947,17 +949,17 @@ use when highlighting the day in the calendar." | |||
| 947 | (day (% omer 7))) | 949 | (day (% omer 7))) |
| 948 | (if (and (> omer 0) (< omer 50)) | 950 | (if (and (> omer 0) (< omer 50)) |
| 949 | (cons mark | 951 | (cons mark |
| 950 | (format "Day %d%s of the omer (until sunset)" | 952 | (format "Day %d%s of the omer (until sunset)" |
| 951 | omer | 953 | omer |
| 952 | (if (zerop week) | 954 | (if (zerop week) |
| 953 | "" | 955 | "" |
| 954 | (format ", that is, %d week%s%s" | 956 | (format ", that is, %d week%s%s" |
| 955 | week | 957 | week |
| 956 | (if (= week 1) "" "s") | 958 | (if (= week 1) "" "s") |
| 957 | (if (zerop day) | 959 | (if (zerop day) |
| 958 | "" | 960 | "" |
| 959 | (format " and %d day%s" | 961 | (format " and %d day%s" |
| 960 | day (if (= day 1) "" "s")))))))))) | 962 | day (if (= day 1) "" "s")))))))))) |
| 961 | 963 | ||
| 962 | (defvar entry) | 964 | (defvar entry) |
| 963 | 965 | ||
| @@ -976,7 +978,7 @@ use when highlighting the day in the calendar." | |||
| 976 | (calendar-absolute-from-gregorian | 978 | (calendar-absolute-from-gregorian |
| 977 | (if european-calendar-style | 979 | (if european-calendar-style |
| 978 | (list death-day death-month death-year) | 980 | (list death-day death-month death-year) |
| 979 | (list death-month death-day death-year))))) | 981 | (list death-month death-day death-year))))) |
| 980 | (h-month (extract-calendar-month h-date)) | 982 | (h-month (extract-calendar-month h-date)) |
| 981 | (h-day (extract-calendar-day h-date)) | 983 | (h-day (extract-calendar-day h-date)) |
| 982 | (h-year (extract-calendar-year h-date)) | 984 | (h-year (extract-calendar-year h-date)) |
| @@ -986,14 +988,14 @@ use when highlighting the day in the calendar." | |||
| 986 | (y (hebrew-calendar-yahrzeit h-date yr))) | 988 | (y (hebrew-calendar-yahrzeit h-date yr))) |
| 987 | (if (and (> diff 0) (or (= y d) (= y (1+ d)))) | 989 | (if (and (> diff 0) (or (= y d) (= y (1+ d)))) |
| 988 | (cons mark | 990 | (cons mark |
| 989 | (format "Yahrzeit of %s%s: %d%s anniversary" | 991 | (format "Yahrzeit of %s%s: %d%s anniversary" |
| 990 | entry | 992 | entry |
| 991 | (if (= y d) "" " (evening)") | 993 | (if (= y d) "" " (evening)") |
| 992 | diff | 994 | diff |
| 993 | (cond ((= (% diff 10) 1) "st") | 995 | (cond ((= (% diff 10) 1) "st") |
| 994 | ((= (% diff 10) 2) "nd") | 996 | ((= (% diff 10) 2) "nd") |
| 995 | ((= (% diff 10) 3) "rd") | 997 | ((= (% diff 10) 3) "rd") |
| 996 | (t "th"))))))) | 998 | (t "th"))))))) |
| 997 | 999 | ||
| 998 | ;;;###diary-autoload | 1000 | ;;;###diary-autoload |
| 999 | (defun diary-rosh-hodesh (&optional mark) | 1001 | (defun diary-rosh-hodesh (&optional mark) |
| @@ -1018,60 +1020,60 @@ use when highlighting the day in the calendar." | |||
| 1018 | (calendar-hebrew-from-absolute (1- d))))) | 1020 | (calendar-hebrew-from-absolute (1- d))))) |
| 1019 | (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7))) | 1021 | (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7))) |
| 1020 | (cons mark | 1022 | (cons mark |
| 1021 | (format | 1023 | (format |
| 1022 | "Rosh Hodesh %s" | 1024 | "Rosh Hodesh %s" |
| 1023 | (if (= h-day 30) | 1025 | (if (= h-day 30) |
| 1024 | (format | 1026 | (format |
| 1025 | "%s (first day)" | 1027 | "%s (first day)" |
| 1026 | ;; Next month must be in the same year since this | 1028 | ;; Next month must be in the same year since this |
| 1027 | ;; month can't be the last month of the year since | 1029 | ;; month can't be the last month of the year since |
| 1028 | ;; it has 30 days | 1030 | ;; it has 30 days |
| 1029 | (aref h-month-names h-month)) | 1031 | (aref h-month-names h-month)) |
| 1030 | (if (= h-yesterday 30) | 1032 | (if (= h-yesterday 30) |
| 1031 | (format "%s (second day)" this-month) | 1033 | (format "%s (second day)" this-month) |
| 1032 | this-month)))) | 1034 | this-month)))) |
| 1033 | (if (= (% d 7) 6) ; Saturday--check for Shabbat Mevarchim | 1035 | (if (= (% d 7) 6) ; Saturday--check for Shabbat Mevarchim |
| 1034 | (cons mark | 1036 | (cons mark |
| 1035 | (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day)) | 1037 | (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day)) |
| 1036 | (format "Mevarchim Rosh Hodesh %s (%s)" | 1038 | (format "Mevarchim Rosh Hodesh %s (%s)" |
| 1037 | (aref h-month-names | 1039 | (aref h-month-names |
| 1038 | (if (= h-month | 1040 | (if (= h-month |
| 1039 | (hebrew-calendar-last-month-of-year | 1041 | (hebrew-calendar-last-month-of-year |
| 1040 | h-year)) | 1042 | h-year)) |
| 1041 | 0 h-month)) | 1043 | 0 h-month)) |
| 1042 | (aref calendar-day-name-array (- 29 h-day)))) | 1044 | (aref calendar-day-name-array (- 29 h-day)))) |
| 1043 | ((and (< h-day 30) (> h-day 22) (= 30 last-day)) | 1045 | ((and (< h-day 30) (> h-day 22) (= 30 last-day)) |
| 1044 | (format "Mevarchim Rosh Hodesh %s (%s-%s)" | 1046 | (format "Mevarchim Rosh Hodesh %s (%s-%s)" |
| 1045 | (aref h-month-names h-month) | 1047 | (aref h-month-names h-month) |
| 1046 | (if (= h-day 29) | 1048 | (if (= h-day 29) |
| 1047 | "tomorrow" | 1049 | "tomorrow" |
| 1048 | (aref calendar-day-name-array (- 29 h-day))) | 1050 | (aref calendar-day-name-array (- 29 h-day))) |
| 1049 | (aref calendar-day-name-array | 1051 | (aref calendar-day-name-array |
| 1050 | (% (- 30 h-day) 7)))))) | 1052 | (% (- 30 h-day) 7)))))) |
| 1051 | (if (and (= h-day 29) (/= h-month 6)) | 1053 | (if (and (= h-day 29) (/= h-month 6)) |
| 1052 | (cons mark | 1054 | (cons mark |
| 1053 | (format "Erev Rosh Hodesh %s" | 1055 | (format "Erev Rosh Hodesh %s" |
| 1054 | (aref h-month-names | 1056 | (aref h-month-names |
| 1055 | (if (= h-month | 1057 | (if (= h-month |
| 1056 | (hebrew-calendar-last-month-of-year | 1058 | (hebrew-calendar-last-month-of-year |
| 1057 | h-year)) | 1059 | h-year)) |
| 1058 | 0 h-month))))))))) | 1060 | 0 h-month))))))))) |
| 1059 | 1061 | ||
| 1060 | (defvar hebrew-calendar-parashiot-names | 1062 | (defvar hebrew-calendar-parashiot-names |
| 1061 | ["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth" | 1063 | ["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth" |
| 1062 | "Vayetze" "Vayishlah" "Vayeshev" "Mikketz" "Vayiggash" "Vayhi" | 1064 | "Vayetze" "Vayishlah" "Vayeshev" "Mikketz" "Vayiggash" "Vayhi" |
| 1063 | "Shemoth" "Vaera" "Bo" "Beshallah" "Yithro" "Mishpatim" | 1065 | "Shemoth" "Vaera" "Bo" "Beshallah" "Yithro" "Mishpatim" |
| 1064 | "Terumah" "Tetzavveh" "Ki Tissa" "Vayakhel" "Pekudei" "Vayikra" | 1066 | "Terumah" "Tetzavveh" "Ki Tissa" "Vayakhel" "Pekudei" "Vayikra" |
| 1065 | "Tzav" "Shemini" "Tazria" "Metzora" "Aharei Moth" "Kedoshim" | 1067 | "Tzav" "Shemini" "Tazria" "Metzora" "Aharei Moth" "Kedoshim" |
| 1066 | "Emor" "Behar" "Behukkotai" "Bemidbar" "Naso" "Behaalot'cha" | 1068 | "Emor" "Behar" "Behukkotai" "Bemidbar" "Naso" "Behaalot'cha" |
| 1067 | "Shelah L'cha" "Korah" "Hukkath" "Balak" "Pinhas" "Mattoth" | 1069 | "Shelah L'cha" "Korah" "Hukkath" "Balak" "Pinhas" "Mattoth" |
| 1068 | "Masei" "Devarim" "Vaethanan" "Ekev" "Reeh" "Shofetim" | 1070 | "Masei" "Devarim" "Vaethanan" "Ekev" "Reeh" "Shofetim" |
| 1069 | "Ki Tetze" "Ki Tavo" "Nitzavim" "Vayelech" "Haazinu"] | 1071 | "Ki Tetze" "Ki Tavo" "Nitzavim" "Vayelech" "Haazinu"] |
| 1070 | "The names of the parashiot in the Torah.") | 1072 | "The names of the parashiot in the Torah.") |
| 1071 | 1073 | ||
| 1072 | (defun hebrew-calendar-parasha-name (p) | 1074 | (defun hebrew-calendar-parasha-name (p) |
| 1073 | "Name(s) corresponding to parasha P." | 1075 | "Name(s) corresponding to parasha P." |
| 1074 | (if (arrayp p) ; combined parasha | 1076 | (if (arrayp p) ; combined parasha |
| 1075 | (format "%s/%s" | 1077 | (format "%s/%s" |
| 1076 | (aref hebrew-calendar-parashiot-names (aref p 0)) | 1078 | (aref hebrew-calendar-parashiot-names (aref p 0)) |
| 1077 | (aref hebrew-calendar-parashiot-names (aref p 1))) | 1079 | (aref hebrew-calendar-parashiot-names (aref p 1))) |
| @@ -1083,7 +1085,7 @@ use when highlighting the day in the calendar." | |||
| 1083 | An optional parameter MARK specifies a face or single-character string to | 1085 | An optional parameter MARK specifies a face or single-character string to |
| 1084 | use when highlighting the day in the calendar." | 1086 | use when highlighting the day in the calendar." |
| 1085 | (let ((d (calendar-absolute-from-gregorian date))) | 1087 | (let ((d (calendar-absolute-from-gregorian date))) |
| 1086 | (if (= (% d 7) 6) ; Saturday | 1088 | (if (= (% d 7) 6) ; Saturday |
| 1087 | (let* | 1089 | (let* |
| 1088 | ((h-year (extract-calendar-year | 1090 | ((h-year (extract-calendar-year |
| 1089 | (calendar-hebrew-from-absolute d))) | 1091 | (calendar-hebrew-from-absolute d))) |
| @@ -1104,81 +1106,81 @@ use when highlighting the day in the calendar." | |||
| 1104 | (symbol-value | 1106 | (symbol-value |
| 1105 | (intern (format "hebrew-calendar-year-%s-%s-%s" ; keviah | 1107 | (intern (format "hebrew-calendar-year-%s-%s-%s" ; keviah |
| 1106 | rosh-hashanah-day type passover-day)))) | 1108 | rosh-hashanah-day type passover-day)))) |
| 1107 | (first-saturday ; of Hebrew year | 1109 | (first-saturday ; of Hebrew year |
| 1108 | (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah))) | 1110 | (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah))) |
| 1109 | (saturday ; which Saturday of the Hebrew year | 1111 | (saturday ; which Saturday of the Hebrew year |
| 1110 | (/ (- d first-saturday) 7)) | 1112 | (/ (- d first-saturday) 7)) |
| 1111 | (parasha (aref year-format saturday))) | 1113 | (parasha (aref year-format saturday))) |
| 1112 | (if parasha | 1114 | (if parasha |
| 1113 | (cons mark | 1115 | (cons mark |
| 1114 | (format | 1116 | (format |
| 1115 | "Parashat %s" | 1117 | "Parashat %s" |
| 1116 | (if (listp parasha) ; Israel differs from diaspora | 1118 | (if (listp parasha) ; Israel differs from diaspora |
| 1117 | (if (car parasha) | 1119 | (if (car parasha) |
| 1118 | (format "%s (diaspora), %s (Israel)" | 1120 | (format "%s (diaspora), %s (Israel)" |
| 1119 | (hebrew-calendar-parasha-name | 1121 | (hebrew-calendar-parasha-name |
| 1120 | (car parasha)) | 1122 | (car parasha)) |
| 1121 | (hebrew-calendar-parasha-name | 1123 | (hebrew-calendar-parasha-name |
| 1122 | (cdr parasha))) | 1124 | (cdr parasha))) |
| 1123 | (format "%s (Israel)" | 1125 | (format "%s (Israel)" |
| 1124 | (hebrew-calendar-parasha-name | 1126 | (hebrew-calendar-parasha-name |
| 1125 | (cdr parasha)))) | 1127 | (cdr parasha)))) |
| 1126 | (hebrew-calendar-parasha-name parasha))))))))) | 1128 | (hebrew-calendar-parasha-name parasha))))))))) |
| 1127 | 1129 | ||
| 1128 | ;; The seven ordinary year types (keviot). | 1130 | ;; The seven ordinary year types (keviot). |
| 1129 | (defconst hebrew-calendar-year-Saturday-incomplete-Sunday | 1131 | (defconst hebrew-calendar-year-Saturday-incomplete-Sunday |
| 1130 | [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] | 1132 | [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] |
| 1131 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] | 1133 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] |
| 1132 | 43 44 45 46 47 48 49 50] | 1134 | 43 44 45 46 47 48 49 50] |
| 1133 | "The structure of the parashiot. | 1135 | "The structure of the parashiot. |
| 1134 | Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have | 1136 | Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have |
| 1135 | 29 days), and has Passover start on Sunday.") | 1137 | 29 days), and has Passover start on Sunday.") |
| 1136 | 1138 | ||
| 1137 | (defconst hebrew-calendar-year-Saturday-complete-Tuesday | 1139 | (defconst hebrew-calendar-year-Saturday-complete-Tuesday |
| 1138 | [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] | 1140 | [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] |
| 1139 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] | 1141 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] |
| 1140 | 43 44 45 46 47 48 49 [50 51]] | 1142 | 43 44 45 46 47 48 49 [50 51]] |
| 1141 | "The structure of the parashiot. | 1143 | "The structure of the parashiot. |
| 1142 | Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each | 1144 | Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each |
| 1143 | have 30 days), and has Passover start on Tuesday.") | 1145 | have 30 days), and has Passover start on Tuesday.") |
| 1144 | 1146 | ||
| 1145 | (defconst hebrew-calendar-year-Monday-incomplete-Tuesday | 1147 | (defconst hebrew-calendar-year-Monday-incomplete-Tuesday |
| 1146 | [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] | 1148 | [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] |
| 1147 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] | 1149 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] |
| 1148 | 43 44 45 46 47 48 49 [50 51]] | 1150 | 43 44 45 46 47 48 49 [50 51]] |
| 1149 | "The structure of the parashiot. | 1151 | "The structure of the parashiot. |
| 1150 | Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each | 1152 | Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each |
| 1151 | have 29 days), and has Passover start on Tuesday.") | 1153 | have 29 days), and has Passover start on Tuesday.") |
| 1152 | 1154 | ||
| 1153 | (defconst hebrew-calendar-year-Monday-complete-Thursday | 1155 | (defconst hebrew-calendar-year-Monday-complete-Thursday |
| 1154 | [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] | 1156 | [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] |
| 1155 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) | 1157 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) |
| 1156 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] | 1158 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] |
| 1157 | "The structure of the parashiot. | 1159 | "The structure of the parashiot. |
| 1158 | Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have | 1160 | Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have |
| 1159 | 30 days), and has Passover start on Thursday.") | 1161 | 30 days), and has Passover start on Thursday.") |
| 1160 | 1162 | ||
| 1161 | (defconst hebrew-calendar-year-Tuesday-regular-Thursday | 1163 | (defconst hebrew-calendar-year-Tuesday-regular-Thursday |
| 1162 | [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] | 1164 | [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] |
| 1163 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) | 1165 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) |
| 1164 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] | 1166 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] |
| 1165 | "The structure of the parashiot. | 1167 | "The structure of the parashiot. |
| 1166 | Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and | 1168 | Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and |
| 1167 | Kislev has 30 days), and has Passover start on Thursday.") | 1169 | Kislev has 30 days), and has Passover start on Thursday.") |
| 1168 | 1170 | ||
| 1169 | (defconst hebrew-calendar-year-Thursday-regular-Saturday | 1171 | (defconst hebrew-calendar-year-Thursday-regular-Saturday |
| 1170 | [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 | 1172 | [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 |
| 1171 | 24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30) | 1173 | 24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30) |
| 1172 | (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 | 1174 | (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 |
| 1173 | 49 50] | 1175 | 49 50] |
| 1174 | "The structure of the parashiot. | 1176 | "The structure of the parashiot. |
| 1175 | Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and | 1177 | Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and |
| 1176 | Kislev has 30 days), and has Passover start on Saturday.") | 1178 | Kislev has 30 days), and has Passover start on Saturday.") |
| 1177 | 1179 | ||
| 1178 | (defconst hebrew-calendar-year-Thursday-complete-Sunday | 1180 | (defconst hebrew-calendar-year-Thursday-complete-Sunday |
| 1179 | [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 | 1181 | [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 |
| 1180 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] | 1182 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] |
| 1181 | 43 44 45 46 47 48 49 50] | 1183 | 43 44 45 46 47 48 49 50] |
| 1182 | "The structure of the parashiot. | 1184 | "The structure of the parashiot. |
| 1183 | Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each | 1185 | Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each |
| 1184 | have 30 days), and has Passover start on Sunday.") | 1186 | have 30 days), and has Passover start on Sunday.") |
| @@ -1186,58 +1188,58 @@ have 30 days), and has Passover start on Sunday.") | |||
| 1186 | ;; The seven leap year types (keviot). | 1188 | ;; The seven leap year types (keviot). |
| 1187 | (defconst hebrew-calendar-year-Saturday-incomplete-Tuesday | 1189 | (defconst hebrew-calendar-year-Saturday-incomplete-Tuesday |
| 1188 | [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 | 1190 | [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 |
| 1189 | 23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42] | 1191 | 23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42] |
| 1190 | 43 44 45 46 47 48 49 [50 51]] | 1192 | 43 44 45 46 47 48 49 [50 51]] |
| 1191 | "The structure of the parashiot. | 1193 | "The structure of the parashiot. |
| 1192 | Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each | 1194 | Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each |
| 1193 | have 29 days), and has Passover start on Tuesday.") | 1195 | have 29 days), and has Passover start on Tuesday.") |
| 1194 | 1196 | ||
| 1195 | (defconst hebrew-calendar-year-Saturday-complete-Thursday | 1197 | (defconst hebrew-calendar-year-Saturday-complete-Thursday |
| 1196 | [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 | 1198 | [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 |
| 1197 | 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) | 1199 | 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) |
| 1198 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] | 1200 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] |
| 1199 | "The structure of the parashiot. | 1201 | "The structure of the parashiot. |
| 1200 | Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each | 1202 | Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each |
| 1201 | have 30 days), and has Passover start on Thursday.") | 1203 | have 30 days), and has Passover start on Thursday.") |
| 1202 | 1204 | ||
| 1203 | (defconst hebrew-calendar-year-Monday-incomplete-Thursday | 1205 | (defconst hebrew-calendar-year-Monday-incomplete-Thursday |
| 1204 | [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 | 1206 | [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 |
| 1205 | 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) | 1207 | 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) |
| 1206 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] | 1208 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] |
| 1207 | "The structure of the parashiot. | 1209 | "The structure of the parashiot. |
| 1208 | Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each | 1210 | Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each |
| 1209 | have 29 days), and has Passover start on Thursday.") | 1211 | have 29 days), and has Passover start on Thursday.") |
| 1210 | 1212 | ||
| 1211 | (defconst hebrew-calendar-year-Monday-complete-Saturday | 1213 | (defconst hebrew-calendar-year-Monday-complete-Saturday |
| 1212 | [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 | 1214 | [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 |
| 1213 | 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) | 1215 | 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) |
| 1214 | (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) | 1216 | (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) |
| 1215 | (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] | 1217 | (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] |
| 1216 | "The structure of the parashiot. | 1218 | "The structure of the parashiot. |
| 1217 | Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have | 1219 | Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have |
| 1218 | 30 days), and has Passover start on Saturday.") | 1220 | 30 days), and has Passover start on Saturday.") |
| 1219 | 1221 | ||
| 1220 | (defconst hebrew-calendar-year-Tuesday-regular-Saturday | 1222 | (defconst hebrew-calendar-year-Tuesday-regular-Saturday |
| 1221 | [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 | 1223 | [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 |
| 1222 | 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) | 1224 | 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) |
| 1223 | (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) | 1225 | (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) |
| 1224 | (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] | 1226 | (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] |
| 1225 | "The structure of the parashiot. | 1227 | "The structure of the parashiot. |
| 1226 | Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and | 1228 | Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and |
| 1227 | Kislev has 30 days), and has Passover start on Saturday.") | 1229 | Kislev has 30 days), and has Passover start on Saturday.") |
| 1228 | 1230 | ||
| 1229 | (defconst hebrew-calendar-year-Thursday-incomplete-Sunday | 1231 | (defconst hebrew-calendar-year-Thursday-incomplete-Sunday |
| 1230 | [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 | 1232 | [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 |
| 1231 | 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | 1233 | 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
| 1232 | 43 44 45 46 47 48 49 50] | 1234 | 43 44 45 46 47 48 49 50] |
| 1233 | "The structure of the parashiot. | 1235 | "The structure of the parashiot. |
| 1234 | Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both | 1236 | Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both |
| 1235 | have 29 days), and has Passover start on Sunday.") | 1237 | have 29 days), and has Passover start on Sunday.") |
| 1236 | 1238 | ||
| 1237 | (defconst hebrew-calendar-year-Thursday-complete-Tuesday | 1239 | (defconst hebrew-calendar-year-Thursday-complete-Tuesday |
| 1238 | [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 | 1240 | [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 |
| 1239 | 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | 1241 | 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
| 1240 | 43 44 45 46 47 48 49 [50 51]] | 1242 | 43 44 45 46 47 48 49 [50 51]] |
| 1241 | "The structure of the parashiot. | 1243 | "The structure of the parashiot. |
| 1242 | Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both | 1244 | Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both |
| 1243 | have 30 days), and has Passover start on Tuesday.") | 1245 | 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 @@ | |||
| 4 | ;; 2006, 2007, 2008 Free Software Foundation, Inc. | 4 | ;; 2006, 2007, 2008 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Stewart M. Clamen <clamen@cs.cmu.edu> | 6 | ;; Author: Stewart M. Clamen <clamen@cs.cmu.edu> |
| 7 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> | 7 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> |
| 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> | 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
| 9 | ;; Keywords: calendar | 9 | ;; Keywords: calendar |
| 10 | ;; Human-Keywords: Mayan calendar, Maya, calendar, diary | 10 | ;; Human-Keywords: Mayan calendar, Maya, calendar, diary |
| @@ -100,12 +100,12 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using | |||
| 100 | (condition-case condition | 100 | (condition-case condition |
| 101 | (progn | 101 | (progn |
| 102 | (while (< cc c) | 102 | (while (< cc c) |
| 103 | (let* ((start (string-match "[0-9]+" str cc)) | 103 | (let* ((start (string-match "[0-9]+" str cc)) |
| 104 | (end (match-end 0)) | 104 | (end (match-end 0)) |
| 105 | datum) | 105 | datum) |
| 106 | (setq datum (read (substring str start end))) | 106 | (setq datum (read (substring str start end))) |
| 107 | (setq rlc (cons datum rlc)) | 107 | (setq rlc (cons datum rlc)) |
| 108 | (setq cc end))) | 108 | (setq cc end))) |
| 109 | (if (not (= (length rlc) 5)) (signal 'invalid-read-syntax nil))) | 109 | (if (not (= (length rlc) 5)) (signal 'invalid-read-syntax nil))) |
| 110 | (invalid-read-syntax nil)) | 110 | (invalid-read-syntax nil)) |
| 111 | (reverse rlc))) | 111 | (reverse rlc))) |
| @@ -125,16 +125,16 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using | |||
| 125 | (defun calendar-mayan-haab-difference (date1 date2) | 125 | (defun calendar-mayan-haab-difference (date1 date2) |
| 126 | "Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2." | 126 | "Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2." |
| 127 | (mod (+ (* 20 (- (cdr date2) (cdr date1))) | 127 | (mod (+ (* 20 (- (cdr date2) (cdr date1))) |
| 128 | (- (car date2) (car date1))) | 128 | (- (car date2) (car date1))) |
| 129 | 365)) | 129 | 365)) |
| 130 | 130 | ||
| 131 | (defun calendar-mayan-haab-on-or-before (haab-date date) | 131 | (defun calendar-mayan-haab-on-or-before (haab-date date) |
| 132 | "Absolute date of latest HAAB-DATE on or before absolute DATE." | 132 | "Absolute date of latest HAAB-DATE on or before absolute DATE." |
| 133 | (- date | 133 | (- date |
| 134 | (% (- date | 134 | (% (- date |
| 135 | (calendar-mayan-haab-difference | 135 | (calendar-mayan-haab-difference |
| 136 | (calendar-mayan-haab-from-absolute 0) haab-date)) | 136 | (calendar-mayan-haab-from-absolute 0) haab-date)) |
| 137 | 365))) | 137 | 365))) |
| 138 | 138 | ||
| 139 | ;;;###cal-autoload | 139 | ;;;###cal-autoload |
| 140 | (defun calendar-next-haab-date (haab-date &optional noecho) | 140 | (defun calendar-next-haab-date (haab-date &optional noecho) |
| @@ -165,12 +165,12 @@ Echo Mayan date if NOECHO is t." | |||
| 165 | "Convert Mayan HAAB date (a pair) into its traditional written form." | 165 | "Convert Mayan HAAB date (a pair) into its traditional written form." |
| 166 | (let ((month (cdr haab)) | 166 | (let ((month (cdr haab)) |
| 167 | (day (car haab))) | 167 | (day (car haab))) |
| 168 | ;; 19th month consists of 5 special days | 168 | ;; 19th month consists of 5 special days |
| 169 | (if (= month 19) | 169 | (if (= month 19) |
| 170 | (format "%d Uayeb" day) | 170 | (format "%d Uayeb" day) |
| 171 | (format "%d %s" | 171 | (format "%d %s" |
| 172 | day | 172 | day |
| 173 | (aref calendar-mayan-haab-month-name-array (1- month)))))) | 173 | (aref calendar-mayan-haab-month-name-array (1- month)))))) |
| 174 | 174 | ||
| 175 | (defun calendar-mayan-tzolkin-from-absolute (date) | 175 | (defun calendar-mayan-tzolkin-from-absolute (date) |
| 176 | "Convert absolute DATE into a Mayan tzolkin date (a pair)." | 176 | "Convert absolute DATE into a Mayan tzolkin date (a pair)." |
| @@ -188,17 +188,17 @@ Echo Mayan date if NOECHO is t." | |||
| 188 | (let ((number-difference (- (car date2) (car date1))) | 188 | (let ((number-difference (- (car date2) (car date1))) |
| 189 | (name-difference (- (cdr date2) (cdr date1)))) | 189 | (name-difference (- (cdr date2) (cdr date1)))) |
| 190 | (mod (+ number-difference | 190 | (mod (+ number-difference |
| 191 | (* 13 (mod (* 3 (- number-difference name-difference)) | 191 | (* 13 (mod (* 3 (- number-difference name-difference)) |
| 192 | 20))) | 192 | 20))) |
| 193 | 260))) | 193 | 260))) |
| 194 | 194 | ||
| 195 | (defun calendar-mayan-tzolkin-on-or-before (tzolkin-date date) | 195 | (defun calendar-mayan-tzolkin-on-or-before (tzolkin-date date) |
| 196 | "Absolute date of latest TZOLKIN-DATE on or before absolute DATE." | 196 | "Absolute date of latest TZOLKIN-DATE on or before absolute DATE." |
| 197 | (- date | 197 | (- date |
| 198 | (% (- date (calendar-mayan-tzolkin-difference | 198 | (% (- date (calendar-mayan-tzolkin-difference |
| 199 | (calendar-mayan-tzolkin-from-absolute 0) | 199 | (calendar-mayan-tzolkin-from-absolute 0) |
| 200 | tzolkin-date)) | 200 | tzolkin-date)) |
| 201 | 260))) | 201 | 260))) |
| 202 | 202 | ||
| 203 | ;;;###cal-autoload | 203 | ;;;###cal-autoload |
| 204 | (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho) | 204 | (defun calendar-next-tzolkin-date (tzolkin-date &optional noecho) |
| @@ -247,8 +247,8 @@ Returns nil if such a tzolkin-haab combination is impossible." | |||
| 247 | (if (= (% difference 5) 0) | 247 | (if (= (% difference 5) 0) |
| 248 | (- date | 248 | (- date |
| 249 | (mod (- date | 249 | (mod (- date |
| 250 | (+ haab-difference (* 365 difference))) | 250 | (+ haab-difference (* 365 difference))) |
| 251 | 18980)) | 251 | 18980)) |
| 252 | nil))) | 252 | nil))) |
| 253 | 253 | ||
| 254 | (defun calendar-read-mayan-haab-date () | 254 | (defun calendar-read-mayan-haab-date () |
| @@ -276,9 +276,9 @@ Returns nil if such a tzolkin-haab combination is impossible." | |||
| 276 | (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil)) | 276 | (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil)) |
| 277 | (tzolkin-name (cdr | 277 | (tzolkin-name (cdr |
| 278 | (assoc-string | 278 | (assoc-string |
| 279 | (completing-read "Tzolkin uinal: " | 279 | (completing-read "Tzolkin uinal: " |
| 280 | (mapcar 'list tzolkin-name-list) | 280 | (mapcar 'list tzolkin-name-list) |
| 281 | nil t) | 281 | nil t) |
| 282 | (calendar-make-alist tzolkin-name-list 1) t)))) | 282 | (calendar-make-alist tzolkin-name-list 1) t)))) |
| 283 | (cons tzolkin-count tzolkin-name))) | 283 | (cons tzolkin-count tzolkin-name))) |
| 284 | 284 | ||
| @@ -321,12 +321,12 @@ Echo Mayan date if NOECHO is t." | |||
| 321 | (defun calendar-absolute-from-mayan-long-count (c) | 321 | (defun calendar-absolute-from-mayan-long-count (c) |
| 322 | "Compute the absolute date corresponding to the Mayan Long Count C. | 322 | "Compute the absolute date corresponding to the Mayan Long Count C. |
| 323 | Long count is a list (baktun katun tun uinal kin)" | 323 | Long count is a list (baktun katun tun uinal kin)" |
| 324 | (+ (* (nth 0 c) 144000) ; baktun | 324 | (+ (* (nth 0 c) 144000) ; baktun |
| 325 | (* (nth 1 c) 7200) ; katun | 325 | (* (nth 1 c) 7200) ; katun |
| 326 | (* (nth 2 c) 360) ; tun | 326 | (* (nth 2 c) 360) ; tun |
| 327 | (* (nth 3 c) 20) ; uinal | 327 | (* (nth 3 c) 20) ; uinal |
| 328 | (nth 4 c) ; kin (days) | 328 | (nth 4 c) ; kin (days) |
| 329 | (- ; days before absolute date 0 | 329 | (- ; days before absolute date 0 |
| 330 | calendar-mayan-days-before-absolute-zero))) | 330 | calendar-mayan-days-before-absolute-zero))) |
| 331 | 331 | ||
| 332 | ;;;###cal-autoload | 332 | ;;;###cal-autoload |
| @@ -338,10 +338,10 @@ Defaults to today's date if DATE is not given." | |||
| 338 | (tzolkin (calendar-mayan-tzolkin-from-absolute d)) | 338 | (tzolkin (calendar-mayan-tzolkin-from-absolute d)) |
| 339 | (haab (calendar-mayan-haab-from-absolute d)) | 339 | (haab (calendar-mayan-haab-from-absolute d)) |
| 340 | (long-count (calendar-mayan-long-count-from-absolute d))) | 340 | (long-count (calendar-mayan-long-count-from-absolute d))) |
| 341 | (format "Long count = %s; tzolkin = %s; haab = %s" | 341 | (format "Long count = %s; tzolkin = %s; haab = %s" |
| 342 | (calendar-mayan-long-count-to-string long-count) | 342 | (calendar-mayan-long-count-to-string long-count) |
| 343 | (calendar-mayan-tzolkin-to-string tzolkin) | 343 | (calendar-mayan-tzolkin-to-string tzolkin) |
| 344 | (calendar-mayan-haab-to-string haab)))) | 344 | (calendar-mayan-haab-to-string haab)))) |
| 345 | 345 | ||
| 346 | ;;;###cal-autoload | 346 | ;;;###cal-autoload |
| 347 | (defun calendar-print-mayan-date () | 347 | (defun calendar-print-mayan-date () |
| @@ -361,8 +361,8 @@ Defaults to today's date if DATE is not given." | |||
| 361 | (read-string "Mayan long count (baktun.katun.tun.uinal.kin): " | 361 | (read-string "Mayan long count (baktun.katun.tun.uinal.kin): " |
| 362 | (calendar-mayan-long-count-to-string | 362 | (calendar-mayan-long-count-to-string |
| 363 | (calendar-mayan-long-count-from-absolute | 363 | (calendar-mayan-long-count-from-absolute |
| 364 | (calendar-absolute-from-gregorian | 364 | (calendar-absolute-from-gregorian |
| 365 | (calendar-current-date)))))))) | 365 | (calendar-current-date)))))))) |
| 366 | (if (calendar-mayan-long-count-common-era datum) | 366 | (if (calendar-mayan-long-count-common-era datum) |
| 367 | (setq lc datum)))) | 367 | (setq lc datum)))) |
| 368 | (list lc))) | 368 | (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 @@ | |||
| 4 | ;; Free Software Foundation, Inc. | 4 | ;; Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | 6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
| 7 | ;; Lara Rios <lrios@coewl.cen.uiuc.edu> | 7 | ;; Lara Rios <lrios@coewl.cen.uiuc.edu> |
| 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> | 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
| 9 | ;; Keywords: calendar | 9 | ;; Keywords: calendar |
| 10 | ;; Human-Keywords: calendar, popup menus, menu bar | 10 | ;; 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." | |||
| 318 | (defun calendar-cursor-to-visible-date (date) | 318 | (defun calendar-cursor-to-visible-date (date) |
| 319 | "Move the cursor to DATE that is on the screen." | 319 | "Move the cursor to DATE that is on the screen." |
| 320 | (let* ((month (extract-calendar-month date)) | 320 | (let* ((month (extract-calendar-month date)) |
| 321 | (day (extract-calendar-day date)) | 321 | (day (extract-calendar-day date)) |
| 322 | (year (extract-calendar-year date)) | 322 | (year (extract-calendar-year date)) |
| 323 | (first-of-month-weekday (calendar-day-of-week (list month 1 year)))) | 323 | (first-of-month-weekday (calendar-day-of-week (list month 1 year)))) |
| 324 | (goto-line (+ 3 | 324 | (goto-line (+ 3 |
| 325 | (/ (+ day -1 | 325 | (/ (+ day -1 |
| 326 | (mod | 326 | (mod |
| 327 | (- (calendar-day-of-week (list month 1 year)) | 327 | (- (calendar-day-of-week (list month 1 year)) |
| 328 | calendar-week-start-day) | 328 | calendar-week-start-day) |
| 329 | 7)) | 329 | 7)) |
| 330 | 7))) | 330 | 7))) |
| 331 | (move-to-column (+ 6 | 331 | (move-to-column (+ 6 |
| 332 | (* 25 | 332 | (* 25 |
| 333 | (1+ (calendar-interval | 333 | (1+ (calendar-interval |
| 334 | displayed-month displayed-year month year))) | 334 | displayed-month displayed-year month year))) |
| 335 | (* 3 (mod | 335 | (* 3 (mod |
| 336 | (- (calendar-day-of-week date) | 336 | (- (calendar-day-of-week date) |
| 337 | calendar-week-start-day) | 337 | calendar-week-start-day) |
| 338 | 7)))))) | 338 | 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." | |||
| 1280 | (cal-tex-list-diary-entries | 1280 | (cal-tex-list-diary-entries |
| 1281 | ;; FIXME d1? | 1281 | ;; FIXME d1? |
| 1282 | (calendar-absolute-from-gregorian (list month 1 year)) | 1282 | (calendar-absolute-from-gregorian (list month 1 year)) |
| 1283 | d2)))) | 1283 | d2)))) |
| 1284 | (cal-tex-preamble "twoside") | 1284 | (cal-tex-preamble "twoside") |
| 1285 | (cal-tex-cmd "\\textwidth 3.25in") | 1285 | (cal-tex-cmd "\\textwidth 3.25in") |
| 1286 | (cal-tex-cmd "\\textheight 6.5in") | 1286 | (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 @@ | |||
| 4 | ;; 2008 Free Software Foundation, Inc. | 4 | ;; 2008 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Michael Kifer <kifer@cs.sunysb.edu> | 6 | ;; Author: Michael Kifer <kifer@cs.sunysb.edu> |
| 7 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> | 7 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> |
| 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> | 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
| 9 | ;; Keywords: calendar | 9 | ;; Keywords: calendar |
| 10 | ;; Human-Keywords: calendar, dedicated frames, X Window System | 10 | ;; Human-Keywords: calendar, dedicated frames, X Window System |
| @@ -91,11 +91,11 @@ passed to `calendar-basic-setup'." | |||
| 91 | (save-window-excursion | 91 | (save-window-excursion |
| 92 | (save-excursion | 92 | (save-excursion |
| 93 | (setq calendar-frame | 93 | (setq calendar-frame |
| 94 | (make-frame calendar-and-diary-frame-parameters)) | 94 | (make-frame calendar-and-diary-frame-parameters)) |
| 95 | (run-hooks 'calendar-after-frame-setup-hooks) | 95 | (run-hooks 'calendar-after-frame-setup-hooks) |
| 96 | (select-frame calendar-frame) | 96 | (select-frame calendar-frame) |
| 97 | (if (eq 'icon (cdr (assoc 'visibility | 97 | (if (eq 'icon (cdr (assoc 'visibility |
| 98 | (frame-parameters calendar-frame)))) | 98 | (frame-parameters calendar-frame)))) |
| 99 | (iconify-or-deiconify-frame)) | 99 | (iconify-or-deiconify-frame)) |
| 100 | (calendar-basic-setup arg) | 100 | (calendar-basic-setup arg) |
| 101 | (set-window-dedicated-p (selected-window) t) | 101 | (set-window-dedicated-p (selected-window) t) |
| @@ -122,11 +122,11 @@ ARG is passed to `calendar-basic-setup'." | |||
| 122 | (save-window-excursion | 122 | (save-window-excursion |
| 123 | (save-excursion | 123 | (save-excursion |
| 124 | (setq calendar-frame | 124 | (setq calendar-frame |
| 125 | (make-frame calendar-frame-parameters)) | 125 | (make-frame calendar-frame-parameters)) |
| 126 | (run-hooks 'calendar-after-frame-setup-hooks) | 126 | (run-hooks 'calendar-after-frame-setup-hooks) |
| 127 | (select-frame calendar-frame) | 127 | (select-frame calendar-frame) |
| 128 | (if (eq 'icon (cdr (assoc 'visibility | 128 | (if (eq 'icon (cdr (assoc 'visibility |
| 129 | (frame-parameters calendar-frame)))) | 129 | (frame-parameters calendar-frame)))) |
| 130 | (iconify-or-deiconify-frame)) | 130 | (iconify-or-deiconify-frame)) |
| 131 | (calendar-basic-setup arg) | 131 | (calendar-basic-setup arg) |
| 132 | (set-window-dedicated-p (selected-window) t)))))) | 132 | (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 | |||
| 494 | "List of pseudo-patterns describing the American patterns of date used. | 494 | "List of pseudo-patterns describing the American patterns of date used. |
| 495 | See the documentation of `diary-date-forms' for an explanation." | 495 | See the documentation of `diary-date-forms' for an explanation." |
| 496 | :type '(repeat (choice (cons :tag "Backup" | 496 | :type '(repeat (choice (cons :tag "Backup" |
| 497 | :value (backup . nil) | 497 | :value (backup . nil) |
| 498 | (const backup) | 498 | (const backup) |
| 499 | (repeat (list :inline t :format "%v" | 499 | (repeat (list :inline t :format "%v" |
| 500 | (symbol :tag "Keyword") | 500 | (symbol :tag "Keyword") |
| 501 | (choice symbol regexp)))) | 501 | (choice symbol regexp)))) |
| 502 | (repeat (list :inline t :format "%v" | 502 | (repeat (list :inline t :format "%v" |
| 503 | (symbol :tag "Keyword") | 503 | (symbol :tag "Keyword") |
| 504 | (choice symbol regexp))))) | 504 | (choice symbol regexp))))) |
| 505 | :group 'diary) | 505 | :group 'diary) |
| 506 | 506 | ||
| 507 | (defcustom european-date-diary-pattern | 507 | (defcustom european-date-diary-pattern |
| @@ -513,14 +513,14 @@ See the documentation of `diary-date-forms' for an explanation." | |||
| 513 | "List of pseudo-patterns describing the European patterns of date used. | 513 | "List of pseudo-patterns describing the European patterns of date used. |
| 514 | See the documentation of `diary-date-forms' for an explanation." | 514 | See the documentation of `diary-date-forms' for an explanation." |
| 515 | :type '(repeat (choice (cons :tag "Backup" | 515 | :type '(repeat (choice (cons :tag "Backup" |
| 516 | :value (backup . nil) | 516 | :value (backup . nil) |
| 517 | (const backup) | 517 | (const backup) |
| 518 | (repeat (list :inline t :format "%v" | 518 | (repeat (list :inline t :format "%v" |
| 519 | (symbol :tag "Keyword") | 519 | (symbol :tag "Keyword") |
| 520 | (choice symbol regexp)))) | 520 | (choice symbol regexp)))) |
| 521 | (repeat (list :inline t :format "%v" | 521 | (repeat (list :inline t :format "%v" |
| 522 | (symbol :tag "Keyword") | 522 | (symbol :tag "Keyword") |
| 523 | (choice symbol regexp))))) | 523 | (choice symbol regexp))))) |
| 524 | :group 'diary) | 524 | :group 'diary) |
| 525 | 525 | ||
| 526 | (defvar diary-font-lock-keywords) | 526 | (defvar diary-font-lock-keywords) |
| @@ -554,14 +554,14 @@ directive causes the date recognizer to back up to the beginning of the | |||
| 554 | current word of the diary entry, so in no case can the pattern match more than | 554 | current word of the diary entry, so in no case can the pattern match more than |
| 555 | a portion of the first word of the diary entry." | 555 | a portion of the first word of the diary entry." |
| 556 | :type '(repeat (choice (cons :tag "Backup" | 556 | :type '(repeat (choice (cons :tag "Backup" |
| 557 | :value (backup . nil) | 557 | :value (backup . nil) |
| 558 | (const backup) | 558 | (const backup) |
| 559 | (repeat (list :inline t :format "%v" | 559 | (repeat (list :inline t :format "%v" |
| 560 | (symbol :tag "Keyword") | 560 | (symbol :tag "Keyword") |
| 561 | (choice symbol regexp)))) | 561 | (choice symbol regexp)))) |
| 562 | (repeat (list :inline t :format "%v" | 562 | (repeat (list :inline t :format "%v" |
| 563 | (symbol :tag "Keyword") | 563 | (symbol :tag "Keyword") |
| 564 | (choice symbol regexp))))) | 564 | (choice symbol regexp))))) |
| 565 | :initialize 'custom-initialize-default | 565 | :initialize 'custom-initialize-default |
| 566 | :set (lambda (symbol value) | 566 | :set (lambda (symbol value) |
| 567 | (unless (equal value (eval symbol)) | 567 | (unless (equal value (eval symbol)) |
| @@ -706,7 +706,7 @@ See the documentation for `calendar-holidays' for details." | |||
| 706 | ;;;###autoload | 706 | ;;;###autoload |
| 707 | (defcustom oriental-holidays | 707 | (defcustom oriental-holidays |
| 708 | '((if (fboundp 'atan) | 708 | '((if (fboundp 'atan) |
| 709 | (holiday-chinese-new-year))) | 709 | (holiday-chinese-new-year))) |
| 710 | "Oriental holidays. | 710 | "Oriental holidays. |
| 711 | See the documentation for `calendar-holidays' for details." | 711 | See the documentation for `calendar-holidays' for details." |
| 712 | :type 'sexp | 712 | :type 'sexp |
| @@ -965,24 +965,24 @@ calendar." | |||
| 965 | (format "Baha'i New Year (Naw-Ruz) %d" (- displayed-year (1- 1844)))) | 965 | (format "Baha'i New Year (Naw-Ruz) %d" (- displayed-year (1- 1844)))) |
| 966 | (holiday-fixed 4 21 "First Day of Ridvan") | 966 | (holiday-fixed 4 21 "First Day of Ridvan") |
| 967 | (if all-bahai-calendar-holidays | 967 | (if all-bahai-calendar-holidays |
| 968 | (holiday-fixed 4 22 "Second Day of Ridvan")) | 968 | (holiday-fixed 4 22 "Second Day of Ridvan")) |
| 969 | (if all-bahai-calendar-holidays | 969 | (if all-bahai-calendar-holidays |
| 970 | (holiday-fixed 4 23 "Third Day of Ridvan")) | 970 | (holiday-fixed 4 23 "Third Day of Ridvan")) |
| 971 | (if all-bahai-calendar-holidays | 971 | (if all-bahai-calendar-holidays |
| 972 | (holiday-fixed 4 24 "Fourth Day of Ridvan")) | 972 | (holiday-fixed 4 24 "Fourth Day of Ridvan")) |
| 973 | (if all-bahai-calendar-holidays | 973 | (if all-bahai-calendar-holidays |
| 974 | (holiday-fixed 4 25 "Fifth Day of Ridvan")) | 974 | (holiday-fixed 4 25 "Fifth Day of Ridvan")) |
| 975 | (if all-bahai-calendar-holidays | 975 | (if all-bahai-calendar-holidays |
| 976 | (holiday-fixed 4 26 "Sixth Day of Ridvan")) | 976 | (holiday-fixed 4 26 "Sixth Day of Ridvan")) |
| 977 | (if all-bahai-calendar-holidays | 977 | (if all-bahai-calendar-holidays |
| 978 | (holiday-fixed 4 27 "Seventh Day of Ridvan")) | 978 | (holiday-fixed 4 27 "Seventh Day of Ridvan")) |
| 979 | (if all-bahai-calendar-holidays | 979 | (if all-bahai-calendar-holidays |
| 980 | (holiday-fixed 4 28 "Eighth Day of Ridvan")) | 980 | (holiday-fixed 4 28 "Eighth Day of Ridvan")) |
| 981 | (holiday-fixed 4 29 "Ninth Day of Ridvan") | 981 | (holiday-fixed 4 29 "Ninth Day of Ridvan") |
| 982 | (if all-bahai-calendar-holidays | 982 | (if all-bahai-calendar-holidays |
| 983 | (holiday-fixed 4 30 "Tenth Day of Ridvan")) | 983 | (holiday-fixed 4 30 "Tenth Day of Ridvan")) |
| 984 | (if all-bahai-calendar-holidays | 984 | (if all-bahai-calendar-holidays |
| 985 | (holiday-fixed 5 1 "Eleventh Day of Ridvan")) | 985 | (holiday-fixed 5 1 "Eleventh Day of Ridvan")) |
| 986 | (holiday-fixed 5 2 "Twelfth Day of Ridvan") | 986 | (holiday-fixed 5 2 "Twelfth Day of Ridvan") |
| 987 | (holiday-fixed 5 23 "Declaration of the Bab") | 987 | (holiday-fixed 5 23 "Declaration of the Bab") |
| 988 | (holiday-fixed 5 29 "Ascension of Baha'u'llah") | 988 | (holiday-fixed 5 29 "Ascension of Baha'u'llah") |
| @@ -990,9 +990,9 @@ calendar." | |||
| 990 | (holiday-fixed 10 20 "Birth of the Bab") | 990 | (holiday-fixed 10 20 "Birth of the Bab") |
| 991 | (holiday-fixed 11 12 "Birth of Baha'u'llah") | 991 | (holiday-fixed 11 12 "Birth of Baha'u'llah") |
| 992 | (if all-bahai-calendar-holidays | 992 | (if all-bahai-calendar-holidays |
| 993 | (holiday-fixed 11 26 "Day of the Covenant")) | 993 | (holiday-fixed 11 26 "Day of the Covenant")) |
| 994 | (if all-bahai-calendar-holidays | 994 | (if all-bahai-calendar-holidays |
| 995 | (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha"))) | 995 | (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha"))) |
| 996 | "Baha'i holidays. | 996 | "Baha'i holidays. |
| 997 | See the documentation for `calendar-holidays' for details." | 997 | See the documentation for `calendar-holidays' for details." |
| 998 | :type 'sexp | 998 | :type 'sexp |
| @@ -1003,7 +1003,7 @@ See the documentation for `calendar-holidays' for details." | |||
| 1003 | ;;;###autoload | 1003 | ;;;###autoload |
| 1004 | (defcustom solar-holidays | 1004 | (defcustom solar-holidays |
| 1005 | '((if (fboundp 'atan) | 1005 | '((if (fboundp 'atan) |
| 1006 | (solar-equinoxes-solstices)) | 1006 | (solar-equinoxes-solstices)) |
| 1007 | (if (require 'cal-dst) | 1007 | (if (require 'cal-dst) |
| 1008 | (funcall | 1008 | (funcall |
| 1009 | 'holiday-sexp | 1009 | 'holiday-sexp |
| @@ -1431,8 +1431,8 @@ Or, for optional MON, YR." | |||
| 1431 | (fit-window-to-buffer nil nil calendar-minimum-window-height)) | 1431 | (fit-window-to-buffer nil nil calendar-minimum-window-height)) |
| 1432 | (sit-for 0)) | 1432 | (sit-for 0)) |
| 1433 | (if (and (boundp 'font-lock-mode) | 1433 | (if (and (boundp 'font-lock-mode) |
| 1434 | font-lock-mode) | 1434 | font-lock-mode) |
| 1435 | (font-lock-fontify-buffer)) | 1435 | (font-lock-fontify-buffer)) |
| 1436 | (and mark-holidays-in-calendar | 1436 | (and mark-holidays-in-calendar |
| 1437 | ;;; (calendar-date-is-valid-p today) ; useful for BC dates | 1437 | ;;; (calendar-date-is-valid-p today) ; useful for BC dates |
| 1438 | (calendar-mark-holidays) | 1438 | (calendar-mark-holidays) |
| @@ -1470,7 +1470,7 @@ line." | |||
| 1470 | (- (calendar-day-of-week (list month 1 year)) | 1470 | (- (calendar-day-of-week (list month 1 year)) |
| 1471 | calendar-week-start-day) | 1471 | calendar-week-start-day) |
| 1472 | 7)) | 1472 | 7)) |
| 1473 | (last (calendar-last-day-of-month month year))) | 1473 | (last (calendar-last-day-of-month month year))) |
| 1474 | (goto-char (point-min)) | 1474 | (goto-char (point-min)) |
| 1475 | (calendar-insert-indented | 1475 | (calendar-insert-indented |
| 1476 | (calendar-string-spread | 1476 | (calendar-string-spread |
| @@ -1496,7 +1496,7 @@ line." | |||
| 1496 | (add-text-properties | 1496 | (add-text-properties |
| 1497 | (- (point) 3) (1- (point)) | 1497 | (- (point) 3) (1- (point)) |
| 1498 | '(mouse-face highlight | 1498 | '(mouse-face highlight |
| 1499 | help-echo "mouse-2: menu of operations for this date")) | 1499 | help-echo "mouse-2: menu of operations for this date")) |
| 1500 | (and (zerop (mod (+ i blank-days) 7)) | 1500 | (and (zerop (mod (+ i blank-days) 7)) |
| 1501 | (/= i last) | 1501 | (/= i last) |
| 1502 | (calendar-insert-indented "" 0 t) ; force onto following line | 1502 | (calendar-insert-indented "" 0 t) ; force onto following line |
| @@ -1696,10 +1696,10 @@ the inserted text. Returns t." | |||
| 1696 | (defcustom calendar-mode-line-format | 1696 | (defcustom calendar-mode-line-format |
| 1697 | (list | 1697 | (list |
| 1698 | (propertize "<" | 1698 | (propertize "<" |
| 1699 | 'help-echo "mouse-1: previous month" | 1699 | 'help-echo "mouse-1: previous month" |
| 1700 | 'mouse-face 'mode-line-highlight | 1700 | 'mouse-face 'mode-line-highlight |
| 1701 | 'keymap (make-mode-line-mouse-map 'mouse-1 | 1701 | 'keymap (make-mode-line-mouse-map 'mouse-1 |
| 1702 | 'calendar-scroll-right)) | 1702 | 'calendar-scroll-right)) |
| 1703 | "Calendar" | 1703 | "Calendar" |
| 1704 | (concat | 1704 | (concat |
| 1705 | (propertize | 1705 | (propertize |
| @@ -1715,7 +1715,7 @@ the inserted text. Returns t." | |||
| 1715 | 'help-echo "mouse-1: choose another month" | 1715 | 'help-echo "mouse-1: choose another month" |
| 1716 | 'mouse-face 'mode-line-highlight | 1716 | 'mouse-face 'mode-line-highlight |
| 1717 | 'keymap (make-mode-line-mouse-map | 1717 | 'keymap (make-mode-line-mouse-map |
| 1718 | 'mouse-1 'mouse-calendar-other-month)) | 1718 | 'mouse-1 'mouse-calendar-other-month)) |
| 1719 | " / " | 1719 | " / " |
| 1720 | (propertize | 1720 | (propertize |
| 1721 | (substitute-command-keys | 1721 | (substitute-command-keys |
| @@ -1725,10 +1725,10 @@ the inserted text. Returns t." | |||
| 1725 | 'keymap (make-mode-line-mouse-map 'mouse-1 #'calendar-goto-today))) | 1725 | 'keymap (make-mode-line-mouse-map 'mouse-1 #'calendar-goto-today))) |
| 1726 | '(calendar-date-string (calendar-current-date) t) | 1726 | '(calendar-date-string (calendar-current-date) t) |
| 1727 | (propertize ">" | 1727 | (propertize ">" |
| 1728 | 'help-echo "mouse-1: next month" | 1728 | 'help-echo "mouse-1: next month" |
| 1729 | 'mouse-face 'mode-line-highlight | 1729 | 'mouse-face 'mode-line-highlight |
| 1730 | 'keymap (make-mode-line-mouse-map | 1730 | 'keymap (make-mode-line-mouse-map |
| 1731 | 'mouse-1 'calendar-scroll-left))) | 1731 | 'mouse-1 'calendar-scroll-left))) |
| 1732 | "The mode line of the calendar buffer. | 1732 | "The mode line of the calendar buffer. |
| 1733 | 1733 | ||
| 1734 | This must be a list of items that evaluate to strings--those strings are | 1734 | 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." | |||
| 1845 | (let ((calendar-buffers (calendar-buffer-list)) | 1845 | (let ((calendar-buffers (calendar-buffer-list)) |
| 1846 | list) | 1846 | list) |
| 1847 | (walk-windows (lambda (w) | 1847 | (walk-windows (lambda (w) |
| 1848 | (if (memq (window-buffer w) calendar-buffers) | 1848 | (if (memq (window-buffer w) calendar-buffers) |
| 1849 | (push w list))) | 1849 | (push w list))) |
| 1850 | nil t) | 1850 | nil t) |
| 1851 | list)) | 1851 | list)) |
| 1852 | 1852 | ||
| @@ -2122,7 +2122,7 @@ If optional NODAY is t, does not ask for day, but just returns | |||
| 2122 | (list month year)) | 2122 | (list month year)) |
| 2123 | (list month | 2123 | (list month |
| 2124 | (calendar-read (format "Day (1-%d): " last) | 2124 | (calendar-read (format "Day (1-%d): " last) |
| 2125 | (lambda (x) (and (< 0 x) (<= x last)))) | 2125 | (lambda (x) (and (< 0 x) (<= x last)))) |
| 2126 | year)))) | 2126 | year)))) |
| 2127 | 2127 | ||
| 2128 | (defun calendar-interval (mon1 yr1 mon2 yr2) | 2128 | (defun calendar-interval (mon1 yr1 mon2 yr2) |
| @@ -2153,11 +2153,11 @@ each element returned has a final `.' character." | |||
| 2153 | 2153 | ||
| 2154 | (defvar calendar-font-lock-keywords | 2154 | (defvar calendar-font-lock-keywords |
| 2155 | `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t) | 2155 | `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t) |
| 2156 | " -?[0-9]+") | 2156 | " -?[0-9]+") |
| 2157 | . font-lock-function-name-face) ; month and year | 2157 | . font-lock-function-name-face) ; month and year |
| 2158 | (,(regexp-opt | 2158 | (,(regexp-opt |
| 2159 | (list (substring (aref calendar-day-name-array 6) 0 2) | 2159 | (list (substring (aref calendar-day-name-array 6) 0 2) |
| 2160 | (substring (aref calendar-day-name-array 0) 0 2))) | 2160 | (substring (aref calendar-day-name-array 0) 0 2))) |
| 2161 | ;; Saturdays and Sundays are highlighted differently. | 2161 | ;; Saturdays and Sundays are highlighted differently. |
| 2162 | . font-lock-comment-face) | 2162 | . font-lock-comment-face) |
| 2163 | ;; First two chars of each day are used in the calendar. | 2163 | ;; 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). | |||
| 2383 | If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise." | 2383 | If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise." |
| 2384 | (if (> n 0) | 2384 | (if (> n 0) |
| 2385 | (+ (* 7 (1- n)) | 2385 | (+ (* 7 (1- n)) |
| 2386 | (calendar-dayname-on-or-before | 2386 | (calendar-dayname-on-or-before |
| 2387 | dayname | 2387 | dayname |
| 2388 | (+ 6 (calendar-absolute-from-gregorian | 2388 | (+ 6 (calendar-absolute-from-gregorian |
| 2389 | (list month (or day 1) year))))) | 2389 | (list month (or day 1) year))))) |
| 2390 | (+ (* 7 (1+ n)) | 2390 | (+ (* 7 (1+ n)) |
| 2391 | (calendar-dayname-on-or-before | 2391 | (calendar-dayname-on-or-before |
| 2392 | dayname | 2392 | dayname |
| 2393 | (calendar-absolute-from-gregorian | 2393 | (calendar-absolute-from-gregorian |
| 2394 | (list month | 2394 | (list month |
| 2395 | (or day (calendar-last-day-of-month month year)) | 2395 | (or day (calendar-last-day-of-month month year)) |
| 2396 | year)))))) | 2396 | year)))))) |
| 2397 | 2397 | ||
| 2398 | (defun calendar-nth-named-day (n dayname month year &optional day) | 2398 | (defun calendar-nth-named-day (n dayname month year &optional day) |
| 2399 | "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY. | 2399 | "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." | |||
| 54 | :type 'face | 54 | :type 'face |
| 55 | :group 'diary) | 55 | :group 'diary) |
| 56 | (make-obsolete-variable 'diary-face "customize the face `diary' instead." | 56 | (make-obsolete-variable 'diary-face "customize the face `diary' instead." |
| 57 | "23.1") | 57 | "23.1") |
| 58 | 58 | ||
| 59 | ;; Face markup of calendar and diary displays: Any entry line that | 59 | ;; Face markup of calendar and diary displays: Any entry line that |
| 60 | ;; ends with [foo:value] where foo is a face attribute (except :box | 60 | ;; 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 | |||
| 90 | attribute being applied. Available TYPES (see `diary-attrtype-convert') | 90 | attribute being applied. Available TYPES (see `diary-attrtype-convert') |
| 91 | are: `string', `symbol', `int', `tnil',`stringtnil.'" | 91 | are: `string', `symbol', `int', `tnil',`stringtnil.'" |
| 92 | :type '(repeat (list (string :tag "Regular expression") | 92 | :type '(repeat (list (string :tag "Regular expression") |
| 93 | (integer :tag "Sub-expression") | 93 | (integer :tag "Sub-expression") |
| 94 | (symbol :tag "Attribute (e.g. :foreground)") | 94 | (symbol :tag "Attribute (e.g. :foreground)") |
| 95 | (choice (const string :tag "A string") | 95 | (choice (const string :tag "A string") |
| 96 | (const symbol :tag "A symbol") | 96 | (const symbol :tag "A symbol") |
| 97 | (const int :tag "An integer") | 97 | (const int :tag "An integer") |
| 98 | (const tnil :tag "`t' or `nil'") | 98 | (const tnil :tag "`t' or `nil'") |
| 99 | (const stringtnil | 99 | (const stringtnil |
| 100 | :tag "A string, `t', or `nil'")))) | 100 | :tag "A string, `t', or `nil'")))) |
| 101 | :group 'diary) | 101 | :group 'diary) |
| 102 | 102 | ||
| 103 | (defcustom diary-glob-file-regexp-prefix "^\\#" | 103 | (defcustom diary-glob-file-regexp-prefix "^\\#" |
| @@ -177,8 +177,8 @@ to cull relevant entries. You can use either or both of | |||
| 177 | describes the style of such diary entries." | 177 | describes the style of such diary entries." |
| 178 | :type 'hook | 178 | :type 'hook |
| 179 | :options '(list-hebrew-diary-entries | 179 | :options '(list-hebrew-diary-entries |
| 180 | list-islamic-diary-entries | 180 | list-islamic-diary-entries |
| 181 | diary-bahai-list-entries) | 181 | diary-bahai-list-entries) |
| 182 | :group 'diary) | 182 | :group 'diary) |
| 183 | 183 | ||
| 184 | (defcustom nongregorian-diary-marking-hook nil | 184 | (defcustom nongregorian-diary-marking-hook nil |
| @@ -190,8 +190,8 @@ to cull relevant entries. You can use either or both of | |||
| 190 | describes the style of such diary entries." | 190 | describes the style of such diary entries." |
| 191 | :type 'hook | 191 | :type 'hook |
| 192 | :options '(mark-hebrew-diary-entries | 192 | :options '(mark-hebrew-diary-entries |
| 193 | mark-islamic-diary-entries | 193 | mark-islamic-diary-entries |
| 194 | diary-bahai-mark-entries) | 194 | diary-bahai-mark-entries) |
| 195 | :group 'diary) | 195 | :group 'diary) |
| 196 | 196 | ||
| 197 | (defcustom print-diary-entries-hook 'lpr-buffer | 197 | (defcustom print-diary-entries-hook 'lpr-buffer |
| @@ -278,10 +278,10 @@ If the template is actually a function, it is called with the message | |||
| 278 | body text as argument, and may use `match-string' etc. to make a | 278 | body text as argument, and may use `match-string' etc. to make a |
| 279 | template following the rules above." | 279 | template following the rules above." |
| 280 | :type '(alist :key-type (regexp :tag "Regexp matching time/place") | 280 | :type '(alist :key-type (regexp :tag "Regexp matching time/place") |
| 281 | :value-type (choice | 281 | :value-type (choice |
| 282 | (string :tag "Template for entry") | 282 | (string :tag "Template for entry") |
| 283 | (function :tag | 283 | (function :tag |
| 284 | "Unary function providing template"))) | 284 | "Unary function providing template"))) |
| 285 | :version "22.1" | 285 | :version "22.1" |
| 286 | :group 'diary) | 286 | :group 'diary) |
| 287 | 287 | ||
| @@ -345,13 +345,13 @@ syntax of `*' and `:' changed to be word constituents.") | |||
| 345 | "Convert string ATTRVALUE to TYPE appropriate for a face description. | 345 | "Convert string ATTRVALUE to TYPE appropriate for a face description. |
| 346 | Valid TYPEs are: string, symbol, int, stringtnil, tnil." | 346 | Valid TYPEs are: string, symbol, int, stringtnil, tnil." |
| 347 | (cond ((eq type 'string) attrvalue) | 347 | (cond ((eq type 'string) attrvalue) |
| 348 | ((eq type 'symbol) (read attrvalue)) ; FIXME intern-soft? | 348 | ((eq type 'symbol) (read attrvalue)) ; FIXME intern-soft? |
| 349 | ((eq type 'int) (string-to-number attrvalue)) | 349 | ((eq type 'int) (string-to-number attrvalue)) |
| 350 | ((eq type 'stringtnil) | 350 | ((eq type 'stringtnil) |
| 351 | (cond ((string-equal "t" attrvalue) t) | 351 | (cond ((string-equal "t" attrvalue) t) |
| 352 | ((string-equal "nil" attrvalue) nil) | 352 | ((string-equal "nil" attrvalue) nil) |
| 353 | (t attrvalue))) | 353 | (t attrvalue))) |
| 354 | ((eq type 'tnil) (string-equal "t" attrvalue)))) | 354 | ((eq type 'tnil) (string-equal "t" attrvalue)))) |
| 355 | 355 | ||
| 356 | (defun diary-pull-attrs (entry fileglobattrs) | 356 | (defun diary-pull-attrs (entry fileglobattrs) |
| 357 | "Search for matches for regexps from `diary-face-attrs'. | 357 | "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) | |||
| 363 | pairs." | 363 | pairs." |
| 364 | (let (regexp regnum attrname attrname attrvalue type ret-attr) | 364 | (let (regexp regnum attrname attrname attrvalue type ret-attr) |
| 365 | (if (null entry) | 365 | (if (null entry) |
| 366 | (save-excursion | 366 | (save-excursion |
| 367 | (dolist (attr diary-face-attrs) | 367 | (dolist (attr diary-face-attrs) |
| 368 | ;; FIXME inefficient searching. | 368 | ;; FIXME inefficient searching. |
| 369 | (goto-char (point-min)) | 369 | (goto-char (point-min)) |
| 370 | (setq regexp (concat diary-glob-file-regexp-prefix (car attr)) | 370 | (setq regexp (concat diary-glob-file-regexp-prefix (car attr)) |
| 371 | regnum (cadr attr) | 371 | regnum (cadr attr) |
| 372 | attrname (nth 2 attr) | 372 | attrname (nth 2 attr) |
| 373 | type (nth 3 attr) | 373 | type (nth 3 attr) |
| 374 | attrvalue (if (re-search-forward regexp nil t) | 374 | attrvalue (if (re-search-forward regexp nil t) |
| 375 | (match-string-no-properties regnum))) | 375 | (match-string-no-properties regnum))) |
| 376 | (and attrvalue | 376 | (and attrvalue |
| 377 | (setq attrvalue (diary-attrtype-convert attrvalue type)) | 377 | (setq attrvalue (diary-attrtype-convert attrvalue type)) |
| 378 | (setq ret-attr (append ret-attr | 378 | (setq ret-attr (append ret-attr |
| 379 | (list attrname attrvalue)))))) | 379 | (list attrname attrvalue)))))) |
| 380 | (setq ret-attr fileglobattrs) | 380 | (setq ret-attr fileglobattrs) |
| 381 | (dolist (attr diary-face-attrs) | 381 | (dolist (attr diary-face-attrs) |
| 382 | (setq regexp (car attr) | 382 | (setq regexp (car attr) |
| 383 | regnum (cadr attr) | 383 | regnum (cadr attr) |
| 384 | attrname (nth 2 attr) | 384 | attrname (nth 2 attr) |
| 385 | type (nth 3 attr) | 385 | type (nth 3 attr) |
| 386 | attrvalue nil) | 386 | attrvalue nil) |
| 387 | ;; FIXME multiple matches? | 387 | ;; FIXME multiple matches? |
| 388 | (if (string-match regexp entry) | 388 | (if (string-match regexp entry) |
| 389 | (setq attrvalue (match-string-no-properties regnum entry) | 389 | (setq attrvalue (match-string-no-properties regnum entry) |
| 390 | entry (replace-match "" t t entry))) | 390 | entry (replace-match "" t t entry))) |
| 391 | (and attrvalue | 391 | (and attrvalue |
| 392 | (setq attrvalue (diary-attrtype-convert attrvalue type)) | 392 | (setq attrvalue (diary-attrtype-convert attrvalue type)) |
| 393 | (setq ret-attr (append ret-attr (list attrname attrvalue)))))) | 393 | (setq ret-attr (append ret-attr (list attrname attrvalue)))))) |
| 394 | (list entry ret-attr))) | 394 | (list entry ret-attr))) |
| 395 | 395 | ||
| 396 | ;;;###cal-autoload | 396 | ;;;###cal-autoload |
| @@ -471,14 +471,14 @@ This variable does not affect the diary display with the `d' command | |||
| 471 | from the calendar; in that case, the prefix argument controls the | 471 | from the calendar; in that case, the prefix argument controls the |
| 472 | number of days of diary entries displayed." | 472 | number of days of diary entries displayed." |
| 473 | :type '(choice (integer :tag "Entries") | 473 | :type '(choice (integer :tag "Entries") |
| 474 | (vector :value [0 0 0 0 0 0 0] | 474 | (vector :value [0 0 0 0 0 0 0] |
| 475 | (integer :tag "Sunday") | 475 | (integer :tag "Sunday") |
| 476 | (integer :tag "Monday") | 476 | (integer :tag "Monday") |
| 477 | (integer :tag "Tuesday") | 477 | (integer :tag "Tuesday") |
| 478 | (integer :tag "Wednesday") | 478 | (integer :tag "Wednesday") |
| 479 | (integer :tag "Thursday") | 479 | (integer :tag "Thursday") |
| 480 | (integer :tag "Friday") | 480 | (integer :tag "Friday") |
| 481 | (integer :tag "Saturday"))) | 481 | (integer :tag "Saturday"))) |
| 482 | :initialize 'custom-initialize-default | 482 | :initialize 'custom-initialize-default |
| 483 | :set 'diary-set-maybe-redraw | 483 | :set 'diary-set-maybe-redraw |
| 484 | :group 'diary) | 484 | :group 'diary) |
| @@ -490,7 +490,7 @@ Can be used by programs integrating a diary list into other buffers (e.g. | |||
| 490 | org.el and planner.el) to modify the string or add properties to it. | 490 | org.el and planner.el) to modify the string or add properties to it. |
| 491 | The function takes a string argument and must return a string.") | 491 | The function takes a string argument and must return a string.") |
| 492 | 492 | ||
| 493 | (defvar diary-entries-list) ; bound in diary-list-entries | 493 | (defvar diary-entries-list) ; bound in diary-list-entries |
| 494 | 494 | ||
| 495 | (defun add-to-diary-list (date string specifier &optional marker | 495 | (defun add-to-diary-list (date string specifier &optional marker |
| 496 | globcolor literal) | 496 | globcolor literal) |
| @@ -513,8 +513,8 @@ FILENAME being the file containing the diary entry." | |||
| 513 | (or (string-equal prefix "") | 513 | (or (string-equal prefix "") |
| 514 | (setq string (format "[%s] %s" prefix string))))) | 514 | (setq string (format "[%s] %s" prefix string))))) |
| 515 | (and diary-modify-entry-list-string-function | 515 | (and diary-modify-entry-list-string-function |
| 516 | (setq string (funcall diary-modify-entry-list-string-function | 516 | (setq string (funcall diary-modify-entry-list-string-function |
| 517 | string))) | 517 | string))) |
| 518 | (setq diary-entries-list | 518 | (setq diary-entries-list |
| 519 | (append diary-entries-list | 519 | (append diary-entries-list |
| 520 | (list (list date string specifier | 520 | (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." | |||
| 567 | (aref number-of-diary-entries (calendar-day-of-week date)) | 567 | (aref number-of-diary-entries (calendar-day-of-week date)) |
| 568 | number-of-diary-entries))) | 568 | number-of-diary-entries))) |
| 569 | (when (> number 0) | 569 | (when (> number 0) |
| 570 | (let ((original-date date) ; save for possible use in the hooks | 570 | (let ((original-date date) ; save for possible use in the hooks |
| 571 | diary-entries-list | 571 | diary-entries-list |
| 572 | file-glob-attrs | 572 | file-glob-attrs |
| 573 | (date-string (calendar-date-string date)) | 573 | (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." | |||
| 611 | (entry-found (list-sexp-diary-entries date))) | 611 | (entry-found (list-sexp-diary-entries date))) |
| 612 | (dolist (date-form diary-date-forms) | 612 | (dolist (date-form diary-date-forms) |
| 613 | (let* ((backup (when (eq (car date-form) 'backup) | 613 | (let* ((backup (when (eq (car date-form) 'backup) |
| 614 | (setq date-form (cdr date-form)) | 614 | (setq date-form (cdr date-form)) |
| 615 | t)) | 615 | t)) |
| 616 | (dayname | 616 | (dayname |
| 617 | (format "%s\\|%s\\.?" | 617 | (format "%s\\|%s\\.?" |
| 618 | (calendar-day-name date) | 618 | (calendar-day-name date) |
| 619 | (calendar-day-name date 'abbrev))) | 619 | (calendar-day-name date 'abbrev))) |
| 620 | (monthname | 620 | (monthname |
| 621 | (format "\\*\\|%s\\|%s\\.?" | 621 | (format "\\*\\|%s\\|%s\\.?" |
| 622 | (calendar-month-name month) | 622 | (calendar-month-name month) |
| 623 | (calendar-month-name month 'abbrev))) | 623 | (calendar-month-name month 'abbrev))) |
| 624 | (month (concat "\\*\\|0*" (int-to-string month))) | 624 | (month (concat "\\*\\|0*" (int-to-string month))) |
| 625 | (day (concat "\\*\\|0*" (int-to-string day))) | 625 | (day (concat "\\*\\|0*" (int-to-string day))) |
| 626 | (year | 626 | (year |
| 627 | (concat | 627 | (concat |
| 628 | "\\*\\|0*" (int-to-string year) | 628 | "\\*\\|0*" (int-to-string year) |
| 629 | (if abbreviated-calendar-year | 629 | (if abbreviated-calendar-year |
| 630 | (concat "\\|" (format "%02d" (% year 100))) | 630 | (concat "\\|" (format "%02d" (% year 100))) |
| 631 | ""))) | 631 | ""))) |
| 632 | (regexp | 632 | (regexp |
| 633 | (concat | 633 | (concat |
| 634 | "^" mark "?\\(" | 634 | "^" mark "?\\(" |
| 635 | ;; This must be let* so that date-form | 635 | ;; This must be let* so that date-form |
| 636 | ;; can use day etc. | 636 | ;; can use day etc. |
| 637 | (mapconcat 'eval date-form "\\)\\(?:") | 637 | (mapconcat 'eval date-form "\\)\\(?:") |
| 638 | "\\)")) | 638 | "\\)")) |
| 639 | (case-fold-search t)) | 639 | (case-fold-search t)) |
| 640 | (goto-char (point-min)) | 640 | (goto-char (point-min)) |
| 641 | (while (re-search-forward regexp nil t) | 641 | (while (re-search-forward regexp nil t) |
| 642 | (if backup (re-search-backward "\\<" nil t)) | 642 | (if backup (re-search-backward "\\<" nil t)) |
| 643 | (if (and (bolp) (not (looking-at "[ \t]"))) | 643 | (if (and (bolp) (not (looking-at "[ \t]"))) |
| 644 | ;; Diary entry that consists only of date. | 644 | ;; Diary entry that consists only of date. |
| 645 | (backward-char 1) | 645 | (backward-char 1) |
| 646 | ;; Found a nonempty diary entry--make it | 646 | ;; Found a nonempty diary entry--make it |
| 647 | ;; visible and add it to the list. | 647 | ;; visible and add it to the list. |
| 648 | (setq entry-found t) | 648 | (setq entry-found t) |
| 649 | (if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) | 649 | (if (looking-at "[ \t]*\n[ \t]") (forward-line 1)) |
| 650 | (let ((entry-start (point)) | 650 | (let ((entry-start (point)) |
| 651 | date-start temp) | 651 | date-start temp) |
| 652 | (setq date-start | 652 | (setq date-start |
| 653 | (line-end-position | 653 | (line-end-position |
| 654 | (if (and (bolp) (> number 1)) -1 0))) | 654 | (if (and (bolp) (> number 1)) -1 0))) |
| 655 | (forward-line 1) | 655 | (forward-line 1) |
| 656 | (while (looking-at "[ \t]") | 656 | (while (looking-at "[ \t]") |
| 657 | (forward-line 1)) | 657 | (forward-line 1)) |
| 658 | (unless (and (eobp) (not (bolp))) | 658 | (unless (and (eobp) (not (bolp))) |
| 659 | (backward-char 1)) | 659 | (backward-char 1)) |
| 660 | (unless list-only | 660 | (unless list-only |
| 661 | (remove-overlays date-start (point) | 661 | (remove-overlays date-start (point) |
| 662 | 'invisible 'diary)) | 662 | 'invisible 'diary)) |
| 663 | (setq temp (diary-pull-attrs | 663 | (setq temp (diary-pull-attrs |
| 664 | (buffer-substring entry-start (point)) | 664 | (buffer-substring entry-start (point)) |
| 665 | file-glob-attrs)) | 665 | file-glob-attrs)) |
| 666 | (add-to-diary-list | 666 | (add-to-diary-list |
| 667 | date | 667 | date |
| 668 | (car temp) | 668 | (car temp) |
| @@ -681,8 +681,8 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." | |||
| 681 | 'list-diary-entries-hook) | 681 | 'list-diary-entries-hook) |
| 682 | (unless list-only | 682 | (unless list-only |
| 683 | (if diary-display-hook | 683 | (if diary-display-hook |
| 684 | (run-hooks 'diary-display-hook) | 684 | (run-hooks 'diary-display-hook) |
| 685 | (simple-diary-display))) | 685 | (simple-diary-display))) |
| 686 | (run-hooks 'diary-hook) | 686 | (run-hooks 'diary-hook) |
| 687 | diary-entries-list)))))) | 687 | diary-entries-list)))))) |
| 688 | 688 | ||
| @@ -692,7 +692,7 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." | |||
| 692 | (remove-overlays (point-min) (point-max) 'invisible 'diary) | 692 | (remove-overlays (point-min) (point-max) 'invisible 'diary) |
| 693 | (kill-local-variable 'mode-line-format)) | 693 | (kill-local-variable 'mode-line-format)) |
| 694 | 694 | ||
| 695 | (defvar original-date) ; bound in diary-list-entries | 695 | (defvar original-date) ; bound in diary-list-entries |
| 696 | (defvar number) | 696 | (defvar number) |
| 697 | 697 | ||
| 698 | (defun include-other-diary-files () | 698 | (defun include-other-diary-files () |
| @@ -712,11 +712,11 @@ changing the variable `diary-include-string'." | |||
| 712 | " \"\\([^\"]*\\)\"") | 712 | " \"\\([^\"]*\\)\"") |
| 713 | nil t) | 713 | nil t) |
| 714 | (let ((diary-file (substitute-in-file-name | 714 | (let ((diary-file (substitute-in-file-name |
| 715 | (match-string-no-properties 1))) | 715 | (match-string-no-properties 1))) |
| 716 | (diary-list-include-blanks nil) | 716 | (diary-list-include-blanks nil) |
| 717 | (list-diary-entries-hook 'include-other-diary-files) | 717 | (list-diary-entries-hook 'include-other-diary-files) |
| 718 | (diary-display-hook 'ignore) | 718 | (diary-display-hook 'ignore) |
| 719 | (diary-hook nil)) | 719 | (diary-hook nil)) |
| 720 | (if (file-exists-p diary-file) | 720 | (if (file-exists-p diary-file) |
| 721 | (if (file-readable-p diary-file) | 721 | (if (file-readable-p diary-file) |
| 722 | (unwind-protect | 722 | (unwind-protect |
| @@ -731,7 +731,7 @@ changing the variable `diary-include-string'." | |||
| 731 | (beep) | 731 | (beep) |
| 732 | (message "Can't find included diary file %s" diary-file) | 732 | (message "Can't find included diary file %s" diary-file) |
| 733 | (sleep-for 2)))) | 733 | (sleep-for 2)))) |
| 734 | (goto-char (point-min))) | 734 | (goto-char (point-min))) |
| 735 | 735 | ||
| 736 | ;; Bound in diary-list-entries. | 736 | ;; Bound in diary-list-entries. |
| 737 | (defvar date-string) | 737 | (defvar date-string) |
| @@ -775,7 +775,7 @@ changing the variable `diary-include-string'." | |||
| 775 | (message "Preparing diary...done")))) | 775 | (message "Preparing diary...done")))) |
| 776 | 776 | ||
| 777 | (defface diary-button '((((type pc) (class color)) | 777 | (defface diary-button '((((type pc) (class color)) |
| 778 | (:foreground "lightblue"))) | 778 | (:foreground "lightblue"))) |
| 779 | "Default face used for buttons." | 779 | "Default face used for buttons." |
| 780 | :version "22.1" | 780 | :version "22.1" |
| 781 | :group 'diary) | 781 | :group 'diary) |
| @@ -845,7 +845,7 @@ This function is provided for optional use as the `diary-display-hook'." | |||
| 845 | (holiday-list-last-month 1) | 845 | (holiday-list-last-month 1) |
| 846 | (holiday-list-last-year 1) | 846 | (holiday-list-last-year 1) |
| 847 | (date (list 0 0 0))) | 847 | (date (list 0 0 0))) |
| 848 | (dolist (entry entry-list) | 848 | (dolist (entry entry-list) |
| 849 | (if (not (calendar-date-equal date (car entry))) | 849 | (if (not (calendar-date-equal date (car entry))) |
| 850 | (progn | 850 | (progn |
| 851 | (setq date (car entry)) | 851 | (setq date (car entry)) |
| @@ -860,7 +860,7 @@ This function is provided for optional use as the `diary-display-hook'." | |||
| 860 | ;; We need to get the holidays for the next 3 months. | 860 | ;; We need to get the holidays for the next 3 months. |
| 861 | (setq holiday-list-last-month | 861 | (setq holiday-list-last-month |
| 862 | (extract-calendar-month date) | 862 | (extract-calendar-month date) |
| 863 | holiday-list-last-year | 863 | holiday-list-last-year |
| 864 | (extract-calendar-year date)) | 864 | (extract-calendar-year date)) |
| 865 | (progn | 865 | (progn |
| 866 | (increment-calendar-month | 866 | (increment-calendar-month |
| @@ -873,62 +873,62 @@ This function is provided for optional use as the `diary-display-hook'." | |||
| 873 | (increment-calendar-month | 873 | (increment-calendar-month |
| 874 | holiday-list-last-month holiday-list-last-year 1)) | 874 | holiday-list-last-month holiday-list-last-year 1)) |
| 875 | (let (date-holiday-list) | 875 | (let (date-holiday-list) |
| 876 | ;; Make a list of all holidays for date. | 876 | ;; Make a list of all holidays for date. |
| 877 | (dolist (h holiday-list) | 877 | (dolist (h holiday-list) |
| 878 | (if (calendar-date-equal date (car h)) | 878 | (if (calendar-date-equal date (car h)) |
| 879 | (setq date-holiday-list (append date-holiday-list | 879 | (setq date-holiday-list (append date-holiday-list |
| 880 | (cdr h))))) | 880 | (cdr h))))) |
| 881 | (insert (if (bobp) "" ?\n) (calendar-date-string date)) | 881 | (insert (if (bobp) "" ?\n) (calendar-date-string date)) |
| 882 | (if date-holiday-list (insert ": ")) | 882 | (if date-holiday-list (insert ": ")) |
| 883 | (let ((l (current-column)) | 883 | (let ((l (current-column)) |
| 884 | (longest 0)) | 884 | (longest 0)) |
| 885 | (insert (mapconcat (lambda (x) | 885 | (insert (mapconcat (lambda (x) |
| 886 | (if (< longest (length x)) | 886 | (if (< longest (length x)) |
| 887 | (setq longest (length x))) | 887 | (setq longest (length x))) |
| 888 | x) | 888 | x) |
| 889 | date-holiday-list | 889 | date-holiday-list |
| 890 | (concat "\n" (make-string l ? )))) | 890 | (concat "\n" (make-string l ? )))) |
| 891 | (insert ?\n (make-string (+ l longest) ?=) ?\n))))) | 891 | (insert ?\n (make-string (+ l longest) ?=) ?\n))))) |
| 892 | (let ((this-entry (cadr entry)) | 892 | (let ((this-entry (cadr entry)) |
| 893 | this-loc) | 893 | this-loc) |
| 894 | (unless (zerop (length this-entry)) | 894 | (unless (zerop (length this-entry)) |
| 895 | (if (setq this-loc (nth 3 entry)) | 895 | (if (setq this-loc (nth 3 entry)) |
| 896 | (insert-button (concat this-entry "\n") | 896 | (insert-button (concat this-entry "\n") |
| 897 | ;; (MARKER FILENAME SPECIFIER LITERAL) | 897 | ;; (MARKER FILENAME SPECIFIER LITERAL) |
| 898 | 'locator (list (car this-loc) | 898 | 'locator (list (car this-loc) |
| 899 | (cadr this-loc) | 899 | (cadr this-loc) |
| 900 | (nth 2 entry) | 900 | (nth 2 entry) |
| 901 | (or (nth 2 this-loc) | 901 | (or (nth 2 this-loc) |
| 902 | (nth 1 entry))) | 902 | (nth 1 entry))) |
| 903 | :type 'diary-entry) | 903 | :type 'diary-entry) |
| 904 | (insert this-entry ?\n)) | 904 | (insert this-entry ?\n)) |
| 905 | (save-excursion | 905 | (save-excursion |
| 906 | (let* ((marks (nth 4 entry)) | 906 | (let* ((marks (nth 4 entry)) |
| 907 | (faceinfo marks) | 907 | (faceinfo marks) |
| 908 | temp-face) | 908 | temp-face) |
| 909 | (when marks | 909 | (when marks |
| 910 | (setq temp-face (make-symbol | 910 | (setq temp-face (make-symbol |
| 911 | (apply | 911 | (apply |
| 912 | 'concat "temp-face-" | 912 | 'concat "temp-face-" |
| 913 | (mapcar (lambda (sym) | 913 | (mapcar (lambda (sym) |
| 914 | (if (stringp sym) | 914 | (if (stringp sym) |
| 915 | sym | 915 | sym |
| 916 | (symbol-name sym))) | 916 | (symbol-name sym))) |
| 917 | marks)))) | 917 | marks)))) |
| 918 | (make-face temp-face) | 918 | (make-face temp-face) |
| 919 | ;; Remove :face info from the marks, | 919 | ;; Remove :face info from the marks, |
| 920 | ;; copy the face info into temp-face | 920 | ;; copy the face info into temp-face |
| 921 | (while (setq faceinfo (memq :face faceinfo)) | 921 | (while (setq faceinfo (memq :face faceinfo)) |
| 922 | (copy-face (read (nth 1 faceinfo)) temp-face) | 922 | (copy-face (read (nth 1 faceinfo)) temp-face) |
| 923 | (setcar faceinfo nil) | 923 | (setcar faceinfo nil) |
| 924 | (setcar (cdr faceinfo) nil)) | 924 | (setcar (cdr faceinfo) nil)) |
| 925 | (setq marks (delq nil marks)) | 925 | (setq marks (delq nil marks)) |
| 926 | ;; Apply the font aspects. | 926 | ;; Apply the font aspects. |
| 927 | (apply 'set-face-attribute temp-face nil marks) | 927 | (apply 'set-face-attribute temp-face nil marks) |
| 928 | (search-backward this-entry) | 928 | (search-backward this-entry) |
| 929 | (overlay-put | 929 | (overlay-put |
| 930 | (make-overlay (match-beginning 0) (match-end 0)) | 930 | (make-overlay (match-beginning 0) (match-end 0)) |
| 931 | 'face temp-face)))))))) | 931 | 'face temp-face)))))))) |
| 932 | (set-buffer-modified-p nil) | 932 | (set-buffer-modified-p nil) |
| 933 | (goto-char (point-min)) | 933 | (goto-char (point-min)) |
| 934 | (setq buffer-read-only t) | 934 | (setq buffer-read-only t) |
| @@ -1166,11 +1166,11 @@ diary entries." | |||
| 1166 | (+ y 100) | 1166 | (+ y 100) |
| 1167 | y))) | 1167 | y))) |
| 1168 | (string-to-number y-str))))) | 1168 | (string-to-number y-str))))) |
| 1169 | (setq marks (nth 1 | 1169 | (setq marks (nth 1 |
| 1170 | (diary-pull-attrs | 1170 | (diary-pull-attrs |
| 1171 | (buffer-substring-no-properties | 1171 | (buffer-substring-no-properties |
| 1172 | (point) (line-end-position)) | 1172 | (point) (line-end-position)) |
| 1173 | file-glob-attrs))) | 1173 | file-glob-attrs))) |
| 1174 | (if dd-name | 1174 | (if dd-name |
| 1175 | (mark-calendar-days-named | 1175 | (mark-calendar-days-named |
| 1176 | (cdr (assoc-string | 1176 | (cdr (assoc-string |
| @@ -1192,7 +1192,7 @@ diary entries." | |||
| 1192 | 'mark-diary-entries-hook)) | 1192 | 'mark-diary-entries-hook)) |
| 1193 | (message "Marking diary entries...done"))))) | 1193 | (message "Marking diary entries...done"))))) |
| 1194 | 1194 | ||
| 1195 | (defvar displayed-year) ; bound in generate-calendar | 1195 | (defvar displayed-year) ; bound in generate-calendar |
| 1196 | (defvar displayed-month) | 1196 | (defvar displayed-month) |
| 1197 | 1197 | ||
| 1198 | (defun mark-sexp-diary-entries () | 1198 | (defun mark-sexp-diary-entries () |
| @@ -1226,7 +1226,7 @@ is marked. See the documentation for the function `list-sexp-diary-entries'." | |||
| 1226 | (setq sexp (buffer-substring-no-properties sexp-start (point))) | 1226 | (setq sexp (buffer-substring-no-properties sexp-start (point))) |
| 1227 | (forward-char 1) | 1227 | (forward-char 1) |
| 1228 | (if (and (bolp) (not (looking-at "[ \t]"))) | 1228 | (if (and (bolp) (not (looking-at "[ \t]"))) |
| 1229 | ;; Diary entry consists only of the sexp. | 1229 | ;; Diary entry consists only of the sexp. |
| 1230 | (progn | 1230 | (progn |
| 1231 | (backward-char 1) | 1231 | (backward-char 1) |
| 1232 | (setq entry "")) | 1232 | (setq entry "")) |
| @@ -1238,17 +1238,17 @@ is marked. See the documentation for the function `list-sexp-diary-entries'." | |||
| 1238 | (if (bolp) (backward-char 1)) | 1238 | (if (bolp) (backward-char 1)) |
| 1239 | (setq entry (buffer-substring-no-properties entry-start (point)))) | 1239 | (setq entry (buffer-substring-no-properties entry-start (point)))) |
| 1240 | (calendar-for-loop date from first-date to last-date do | 1240 | (calendar-for-loop date from first-date to last-date do |
| 1241 | (if (setq mark (diary-sexp-entry sexp entry | 1241 | (if (setq mark (diary-sexp-entry sexp entry |
| 1242 | (calendar-gregorian-from-absolute date))) | 1242 | (calendar-gregorian-from-absolute date))) |
| 1243 | (progn | 1243 | (progn |
| 1244 | (setq marks (diary-pull-attrs entry file-glob-attrs) | 1244 | (setq marks (diary-pull-attrs entry file-glob-attrs) |
| 1245 | marks (nth 1 (diary-pull-attrs entry file-glob-attrs))) | 1245 | marks (nth 1 (diary-pull-attrs entry file-glob-attrs))) |
| 1246 | (mark-visible-calendar-date | 1246 | (mark-visible-calendar-date |
| 1247 | (calendar-gregorian-from-absolute date) | 1247 | (calendar-gregorian-from-absolute date) |
| 1248 | (if (< 0 (length marks)) | 1248 | (if (< 0 (length marks)) |
| 1249 | marks | 1249 | marks |
| 1250 | (if (consp mark) | 1250 | (if (consp mark) |
| 1251 | (car mark))))))))))) | 1251 | (car mark))))))))))) |
| 1252 | 1252 | ||
| 1253 | (defun mark-included-diary-files () | 1253 | (defun mark-included-diary-files () |
| 1254 | "Mark the diary entries from other diary files with those of the diary file. | 1254 | "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." | |||
| 1299 | (increment-calendar-month prev-month prev-year -1) | 1299 | (increment-calendar-month prev-month prev-year -1) |
| 1300 | (setq day (calendar-absolute-from-gregorian | 1300 | (setq day (calendar-absolute-from-gregorian |
| 1301 | (calendar-nth-named-day 1 dayname prev-month prev-year)) | 1301 | (calendar-nth-named-day 1 dayname prev-month prev-year)) |
| 1302 | last-day (calendar-absolute-from-gregorian | 1302 | last-day (calendar-absolute-from-gregorian |
| 1303 | (calendar-nth-named-day -1 dayname succ-month succ-year))) | 1303 | (calendar-nth-named-day -1 dayname succ-month succ-year))) |
| 1304 | (while (<= day last-day) | 1304 | (while (<= day last-day) |
| 1305 | (mark-visible-calendar-date (calendar-gregorian-from-absolute day) | 1305 | (mark-visible-calendar-date (calendar-gregorian-from-absolute day) |
| 1306 | color) | 1306 | color) |
| 1307 | (setq day (+ day 7)))))) | 1307 | (setq day (+ day 7)))))) |
| 1308 | 1308 | ||
| 1309 | (defun mark-calendar-date-pattern (month day year &optional color) | 1309 | (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." | |||
| 1328 | (or (zerop p-year) (= year p-year)))) | 1328 | (or (zerop p-year) (= year p-year)))) |
| 1329 | (if (zerop p-day) | 1329 | (if (zerop p-day) |
| 1330 | (calendar-for-loop | 1330 | (calendar-for-loop |
| 1331 | i from 1 to (calendar-last-day-of-month month year) do | 1331 | i from 1 to (calendar-last-day-of-month month year) do |
| 1332 | (mark-visible-calendar-date (list month i year) color)) | 1332 | (mark-visible-calendar-date (list month i year) color)) |
| 1333 | (mark-visible-calendar-date (list month p-day year) color)))) | 1333 | (mark-visible-calendar-date (list month p-day year) color)))) |
| 1334 | 1334 | ||
| 1335 | (defun sort-diary-entries () | 1335 | (defun sort-diary-entries () |
| @@ -1355,23 +1355,23 @@ The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam, | |||
| 1355 | XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can | 1355 | XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can |
| 1356 | be used instead of a colon (:) to separate the hour and minute parts." | 1356 | be used instead of a colon (:) to separate the hour and minute parts." |
| 1357 | (let ((case-fold-search nil)) | 1357 | (let ((case-fold-search nil)) |
| 1358 | (cond ((string-match ; military time | 1358 | (cond ((string-match ; military time |
| 1359 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" | 1359 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" |
| 1360 | s) | 1360 | s) |
| 1361 | (+ (* 100 (string-to-number (match-string 1 s))) | 1361 | (+ (* 100 (string-to-number (match-string 1 s))) |
| 1362 | (string-to-number (match-string 2 s)))) | 1362 | (string-to-number (match-string 2 s)))) |
| 1363 | ((string-match ; hour only (XXam or XXpm) | 1363 | ((string-match ; hour only (XXam or XXpm) |
| 1364 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) | 1364 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) |
| 1365 | (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) | 1365 | (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) |
| 1366 | (if (equal ?a (downcase (aref s (match-beginning 2)))) | 1366 | (if (equal ?a (downcase (aref s (match-beginning 2)))) |
| 1367 | 0 1200))) | 1367 | 0 1200))) |
| 1368 | ((string-match ; hour and minute (XX:XXam or XX:XXpm) | 1368 | ((string-match ; hour and minute (XX:XXam or XX:XXpm) |
| 1369 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) | 1369 | "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) |
| 1370 | (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) | 1370 | (+ (* 100 (% (string-to-number (match-string 1 s)) 12)) |
| 1371 | (string-to-number (match-string 2 s)) | 1371 | (string-to-number (match-string 2 s)) |
| 1372 | (if (equal ?a (downcase (aref s (match-beginning 3)))) | 1372 | (if (equal ?a (downcase (aref s (match-beginning 3)))) |
| 1373 | 0 1200))) | 1373 | 0 1200))) |
| 1374 | (t diary-unknown-time)))) ; unrecognizable | 1374 | (t diary-unknown-time)))) ; unrecognizable |
| 1375 | 1375 | ||
| 1376 | (defun list-sexp-diary-entries (date) | 1376 | (defun list-sexp-diary-entries (date) |
| 1377 | "Add sexp entries for DATE from the diary file to `diary-entries-list'. | 1377 | "Add sexp entries for DATE from the diary file to `diary-entries-list'. |
| @@ -1557,7 +1557,7 @@ best if they are nonmarking." | |||
| 1557 | entry-start (1+ line-start)) | 1557 | entry-start (1+ line-start)) |
| 1558 | (forward-char 1) | 1558 | (forward-char 1) |
| 1559 | (if (and (bolp) (not (looking-at "[ \t]"))) | 1559 | (if (and (bolp) (not (looking-at "[ \t]"))) |
| 1560 | ;; Diary entry consists only of the sexp. | 1560 | ;; Diary entry consists only of the sexp. |
| 1561 | (progn | 1561 | (progn |
| 1562 | (backward-char 1) | 1562 | (backward-char 1) |
| 1563 | (setq entry "")) | 1563 | (setq entry "")) |
| @@ -1604,9 +1604,9 @@ best if they are nonmarking." | |||
| 1604 | diary-file sexp) | 1604 | diary-file sexp) |
| 1605 | (sleep-for 2)))))) | 1605 | (sleep-for 2)))))) |
| 1606 | (cond ((stringp result) result) | 1606 | (cond ((stringp result) result) |
| 1607 | ((and (consp result) | 1607 | ((and (consp result) |
| 1608 | (stringp (cdr result))) result) | 1608 | (stringp (cdr result))) result) |
| 1609 | (result entry) | 1609 | (result entry) |
| 1610 | (t nil)))) | 1610 | (t nil)))) |
| 1611 | 1611 | ||
| 1612 | (defvar date) | 1612 | (defvar date) |
| @@ -1676,15 +1676,15 @@ backward from the end of the month. | |||
| 1676 | An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. | 1676 | An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. |
| 1677 | Optional MARK specifies a face or single-character string to use when | 1677 | Optional MARK specifies a face or single-character string to use when |
| 1678 | highlighting the day in the calendar." | 1678 | highlighting the day in the calendar." |
| 1679 | ;; This is messy because the diary entry may apply, but the date on which it | 1679 | ;; This is messy because the diary entry may apply, but the date on which it |
| 1680 | ;; is based can be in a different month/year. For example, asking for the | 1680 | ;; is based can be in a different month/year. For example, asking for the |
| 1681 | ;; first Monday after December 30. For large values of |n| the problem is | 1681 | ;; first Monday after December 30. For large values of |n| the problem is |
| 1682 | ;; more grotesque. | 1682 | ;; more grotesque. |
| 1683 | (and (= dayname (calendar-day-of-week date)) | 1683 | (and (= dayname (calendar-day-of-week date)) |
| 1684 | (let* ((m (extract-calendar-month date)) | 1684 | (let* ((m (extract-calendar-month date)) |
| 1685 | (d (extract-calendar-day date)) | 1685 | (d (extract-calendar-day date)) |
| 1686 | (y (extract-calendar-year date)) | 1686 | (y (extract-calendar-year date)) |
| 1687 | ;; Last (n>0) or first (n<0) possible base date for entry. | 1687 | ;; Last (n>0) or first (n<0) possible base date for entry. |
| 1688 | (limit | 1688 | (limit |
| 1689 | (calendar-nth-named-absday (- n) dayname m y d)) | 1689 | (calendar-nth-named-absday (- n) dayname m y d)) |
| 1690 | (last-abs (if (> n 0) limit (+ limit 6))) | 1690 | (last-abs (if (> n 0) limit (+ limit 6))) |
| @@ -1699,38 +1699,38 @@ highlighting the day in the calendar." | |||
| 1699 | (m2 (extract-calendar-month last)) | 1699 | (m2 (extract-calendar-month last)) |
| 1700 | (d2 (extract-calendar-day last)) | 1700 | (d2 (extract-calendar-day last)) |
| 1701 | (y2 (extract-calendar-year last))) | 1701 | (y2 (extract-calendar-year last))) |
| 1702 | (if (or (and (= m1 m2) ; only possible base dates in one month | 1702 | (if (or (and (= m1 m2) ; only possible base dates in one month |
| 1703 | (or (eq month t) | 1703 | (or (eq month t) |
| 1704 | (if (listp month) | 1704 | (if (listp month) |
| 1705 | (memq m1 month) | 1705 | (memq m1 month) |
| 1706 | (= m1 month))) | 1706 | (= m1 month))) |
| 1707 | (let ((d (or day (if (> n 0) | 1707 | (let ((d (or day (if (> n 0) |
| 1708 | 1 | 1708 | 1 |
| 1709 | (calendar-last-day-of-month m1 y1))))) | 1709 | (calendar-last-day-of-month m1 y1))))) |
| 1710 | (and (<= d1 d) (<= d d2)))) | 1710 | (and (<= d1 d) (<= d d2)))) |
| 1711 | ;; Only possible base dates straddle two months. | 1711 | ;; Only possible base dates straddle two months. |
| 1712 | (and (or (< y1 y2) | 1712 | (and (or (< y1 y2) |
| 1713 | (and (= y1 y2) (< m1 m2))) | 1713 | (and (= y1 y2) (< m1 m2))) |
| 1714 | (or | 1714 | (or |
| 1715 | ;; m1, d1 works as a base date. | 1715 | ;; m1, d1 works as a base date. |
| 1716 | (and | 1716 | (and |
| 1717 | (or (eq month t) | 1717 | (or (eq month t) |
| 1718 | (if (listp month) | 1718 | (if (listp month) |
| 1719 | (memq m1 month) | 1719 | (memq m1 month) |
| 1720 | (= m1 month))) | 1720 | (= m1 month))) |
| 1721 | (<= d1 (or day (if (> n 0) | 1721 | (<= d1 (or day (if (> n 0) |
| 1722 | 1 | 1722 | 1 |
| 1723 | (calendar-last-day-of-month m1 y1))))) | 1723 | (calendar-last-day-of-month m1 y1))))) |
| 1724 | ;; m2, d2 works as a base date. | 1724 | ;; m2, d2 works as a base date. |
| 1725 | (and (or (eq month t) | 1725 | (and (or (eq month t) |
| 1726 | (if (listp month) | 1726 | (if (listp month) |
| 1727 | (memq m2 month) | 1727 | (memq m2 month) |
| 1728 | (= m2 month))) | 1728 | (= m2 month))) |
| 1729 | (<= (or day (if (> n 0) | 1729 | (<= (or day (if (> n 0) |
| 1730 | 1 | 1730 | 1 |
| 1731 | (calendar-last-day-of-month m2 y2))) | 1731 | (calendar-last-day-of-month m2 y2))) |
| 1732 | d2))))) | 1732 | d2))))) |
| 1733 | (cons mark entry))))) | 1733 | (cons mark entry))))) |
| 1734 | 1734 | ||
| 1735 | ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. | 1735 | ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. |
| 1736 | (defun diary-anniversary (month day &optional year mark) | 1736 | (defun diary-anniversary (month day &optional year mark) |
| @@ -1818,7 +1818,7 @@ marked on the calendar." | |||
| 1818 | diary-entry) | 1818 | diary-entry) |
| 1819 | ;; Diary entry may apply to `days' before date. | 1819 | ;; Diary entry may apply to `days' before date. |
| 1820 | ((and (integerp days) | 1820 | ((and (integerp days) |
| 1821 | (not diary-entry) ; diary entry does not apply to date | 1821 | (not diary-entry) ; diary entry does not apply to date |
| 1822 | (or (not marking-diary-entries) marking)) | 1822 | (or (not marking-diary-entries) marking)) |
| 1823 | (let ((date (calendar-gregorian-from-absolute | 1823 | (let ((date (calendar-gregorian-from-absolute |
| 1824 | (+ (calendar-absolute-from-gregorian date) days)))) | 1824 | (+ (calendar-absolute-from-gregorian date) days)))) |
| @@ -1926,21 +1926,21 @@ Prefix argument ARG makes the entry nonmarking." | |||
| 1926 | (if european-calendar-style | 1926 | (if european-calendar-style |
| 1927 | '(day " " month " " year) | 1927 | '(day " " month " " year) |
| 1928 | '(month " " day " " year))) | 1928 | '(month " " day " " year))) |
| 1929 | (cursor (calendar-cursor-to-date t)) | 1929 | (cursor (calendar-cursor-to-date t)) |
| 1930 | (mark (or (car calendar-mark-ring) | 1930 | (mark (or (car calendar-mark-ring) |
| 1931 | (error "No mark set in this buffer"))) | 1931 | (error "No mark set in this buffer"))) |
| 1932 | start end) | 1932 | start end) |
| 1933 | (if (< (calendar-absolute-from-gregorian mark) | 1933 | (if (< (calendar-absolute-from-gregorian mark) |
| 1934 | (calendar-absolute-from-gregorian cursor)) | 1934 | (calendar-absolute-from-gregorian cursor)) |
| 1935 | (setq start mark | 1935 | (setq start mark |
| 1936 | end cursor) | 1936 | end cursor) |
| 1937 | (setq start cursor | 1937 | (setq start cursor |
| 1938 | end mark)) | 1938 | end mark)) |
| 1939 | (make-diary-entry | 1939 | (make-diary-entry |
| 1940 | (format "%s(diary-block %s %s)" | 1940 | (format "%s(diary-block %s %s)" |
| 1941 | sexp-diary-entry-symbol | 1941 | sexp-diary-entry-symbol |
| 1942 | (calendar-date-string start nil t) | 1942 | (calendar-date-string start nil t) |
| 1943 | (calendar-date-string end nil t)) | 1943 | (calendar-date-string end nil t)) |
| 1944 | arg))) | 1944 | arg))) |
| 1945 | 1945 | ||
| 1946 | ;;;###cal-autoload | 1946 | ;;;###cal-autoload |
| @@ -2065,13 +2065,13 @@ Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'." | |||
| 2065 | "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)") | 2065 | "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)") |
| 2066 | limit t) | 2066 | limit t) |
| 2067 | (condition-case nil | 2067 | (condition-case nil |
| 2068 | (save-restriction | 2068 | (save-restriction |
| 2069 | (narrow-to-region (point-min) limit) | 2069 | (narrow-to-region (point-min) limit) |
| 2070 | (let ((start (point))) | 2070 | (let ((start (point))) |
| 2071 | (forward-sexp 1) | 2071 | (forward-sexp 1) |
| 2072 | (store-match-data (list start (point))) | 2072 | (store-match-data (list start (point))) |
| 2073 | t)) | 2073 | t)) |
| 2074 | (error t)))) | 2074 | (error t)))) |
| 2075 | 2075 | ||
| 2076 | (defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array) | 2076 | (defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array) |
| 2077 | "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. | 2077 | "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY. |
| @@ -2088,21 +2088,21 @@ names." | |||
| 2088 | (day "\\([0-9]+\\|\\*\\)") | 2088 | (day "\\([0-9]+\\|\\*\\)") |
| 2089 | (year "-?\\([0-9]+\\|\\*\\)")) | 2089 | (year "-?\\([0-9]+\\|\\*\\)")) |
| 2090 | (mapcar (lambda (x) | 2090 | (mapcar (lambda (x) |
| 2091 | (cons | 2091 | (cons |
| 2092 | (concat "^" (regexp-quote diary-nonmarking-symbol) "?" | 2092 | (concat "^" (regexp-quote diary-nonmarking-symbol) "?" |
| 2093 | (if symbol (regexp-quote symbol) "") "\\(" | 2093 | (if symbol (regexp-quote symbol) "") "\\(" |
| 2094 | (mapconcat 'eval | 2094 | (mapconcat 'eval |
| 2095 | ;; If backup, omit first item (backup) | 2095 | ;; If backup, omit first item (backup) |
| 2096 | ;; and last item (not part of date). | 2096 | ;; and last item (not part of date). |
| 2097 | (if (equal (car x) 'backup) | 2097 | (if (equal (car x) 'backup) |
| 2098 | (nreverse (cdr (reverse (cdr x)))) | 2098 | (nreverse (cdr (reverse (cdr x)))) |
| 2099 | x) | 2099 | x) |
| 2100 | "") | 2100 | "") |
| 2101 | ;; With backup, last item is not part of date. | 2101 | ;; With backup, last item is not part of date. |
| 2102 | (if (equal (car x) 'backup) | 2102 | (if (equal (car x) 'backup) |
| 2103 | (concat "\\)" (eval (car (reverse x)))) | 2103 | (concat "\\)" (eval (car (reverse x)))) |
| 2104 | "\\)")) | 2104 | "\\)")) |
| 2105 | '(1 diary-face))) | 2105 | '(1 diary-face))) |
| 2106 | diary-date-forms))) | 2106 | diary-date-forms))) |
| 2107 | 2107 | ||
| 2108 | (defvar calendar-hebrew-month-name-array-leap-year) | 2108 | (defvar calendar-hebrew-month-name-array-leap-year) |
| @@ -2130,9 +2130,9 @@ names." | |||
| 2130 | (diary-font-lock-date-forms | 2130 | (diary-font-lock-date-forms |
| 2131 | calendar-islamic-month-name-array islamic-diary-entry-symbol)) | 2131 | calendar-islamic-month-name-array islamic-diary-entry-symbol)) |
| 2132 | (when (or (memq 'diary-bahai-mark-entries | 2132 | (when (or (memq 'diary-bahai-mark-entries |
| 2133 | nongregorian-diary-marking-hook) | 2133 | nongregorian-diary-marking-hook) |
| 2134 | (memq 'diary-bahai-list-entries | 2134 | (memq 'diary-bahai-list-entries |
| 2135 | nongregorian-diary-marking-hook)) | 2135 | nongregorian-diary-marking-hook)) |
| 2136 | (require 'cal-bahai) | 2136 | (require 'cal-bahai) |
| 2137 | (diary-font-lock-date-forms | 2137 | (diary-font-lock-date-forms |
| 2138 | calendar-bahai-month-name-array bahai-diary-entry-symbol)) | 2138 | calendar-bahai-month-name-array bahai-diary-entry-symbol)) |
| @@ -2142,22 +2142,22 @@ names." | |||
| 2142 | 'font-lock-keyword-face) | 2142 | 'font-lock-keyword-face) |
| 2143 | (cons | 2143 | (cons |
| 2144 | (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol) | 2144 | (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol) |
| 2145 | (regexp-quote sexp-diary-entry-symbol)) | 2145 | (regexp-quote sexp-diary-entry-symbol)) |
| 2146 | '(1 font-lock-reference-face)) | 2146 | '(1 font-lock-reference-face)) |
| 2147 | (cons | 2147 | (cons |
| 2148 | (format "^%s" (regexp-quote diary-nonmarking-symbol)) | 2148 | (format "^%s" (regexp-quote diary-nonmarking-symbol)) |
| 2149 | 'font-lock-reference-face) | 2149 | 'font-lock-reference-face) |
| 2150 | (cons | 2150 | (cons |
| 2151 | (format "^%s?%s" (regexp-quote diary-nonmarking-symbol) | 2151 | (format "^%s?%s" (regexp-quote diary-nonmarking-symbol) |
| 2152 | (regexp-opt (mapcar 'regexp-quote | 2152 | (regexp-opt (mapcar 'regexp-quote |
| 2153 | (list hebrew-diary-entry-symbol | 2153 | (list hebrew-diary-entry-symbol |
| 2154 | islamic-diary-entry-symbol | 2154 | islamic-diary-entry-symbol |
| 2155 | bahai-diary-entry-symbol)) | 2155 | bahai-diary-entry-symbol)) |
| 2156 | t)) | 2156 | t)) |
| 2157 | '(1 font-lock-reference-face)) | 2157 | '(1 font-lock-reference-face)) |
| 2158 | '(diary-font-lock-sexps . font-lock-keyword-face) | 2158 | '(diary-font-lock-sexps . font-lock-keyword-face) |
| 2159 | `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp | 2159 | `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp |
| 2160 | diary-time-regexp) | 2160 | diary-time-regexp) |
| 2161 | . 'diary-time)))) | 2161 | . 'diary-time)))) |
| 2162 | 2162 | ||
| 2163 | (defvar diary-font-lock-keywords (diary-font-lock-keywords) | 2163 | (defvar diary-font-lock-keywords (diary-font-lock-keywords) |
| @@ -2184,23 +2184,23 @@ message contains an appointment, don't make a diary entry." | |||
| 2184 | (catch 'finished | 2184 | (catch 'finished |
| 2185 | (let (format-string) | 2185 | (let (format-string) |
| 2186 | (dotimes (i (length diary-outlook-formats)) | 2186 | (dotimes (i (length diary-outlook-formats)) |
| 2187 | (when (eq 0 (string-match (car (nth i diary-outlook-formats)) | 2187 | (when (eq 0 (string-match (car (nth i diary-outlook-formats)) |
| 2188 | body)) | 2188 | body)) |
| 2189 | (unless test-only | 2189 | (unless test-only |
| 2190 | (setq format-string (cdr (nth i diary-outlook-formats))) | 2190 | (setq format-string (cdr (nth i diary-outlook-formats))) |
| 2191 | (save-excursion | 2191 | (save-excursion |
| 2192 | (save-window-excursion | 2192 | (save-window-excursion |
| 2193 | ;; Fixme: References to optional fields in the format | 2193 | ;; Fixme: References to optional fields in the format |
| 2194 | ;; are treated literally, not replaced by the empty | 2194 | ;; are treated literally, not replaced by the empty |
| 2195 | ;; string. I think this is an Emacs bug. | 2195 | ;; string. I think this is an Emacs bug. |
| 2196 | (make-diary-entry | 2196 | (make-diary-entry |
| 2197 | (format (replace-match (if (functionp format-string) | 2197 | (format (replace-match (if (functionp format-string) |
| 2198 | (funcall format-string body) | 2198 | (funcall format-string body) |
| 2199 | format-string) | 2199 | format-string) |
| 2200 | t nil (match-string 0 body)) | 2200 | t nil (match-string 0 body)) |
| 2201 | subject)) | 2201 | subject)) |
| 2202 | (save-buffer)))) | 2202 | (save-buffer)))) |
| 2203 | (throw 'finished t)))) | 2203 | (throw 'finished t)))) |
| 2204 | nil)) | 2204 | nil)) |
| 2205 | 2205 | ||
| 2206 | (defun diary-from-outlook (&optional noconfirm) | 2206 | (defun diary-from-outlook (&optional noconfirm) |
| @@ -2211,11 +2211,11 @@ function is called interactively), then if an entry is found the | |||
| 2211 | user is asked to confirm its addition." | 2211 | user is asked to confirm its addition." |
| 2212 | (interactive "p") | 2212 | (interactive "p") |
| 2213 | (let ((func (cond | 2213 | (let ((func (cond |
| 2214 | ((eq major-mode 'rmail-mode) | 2214 | ((eq major-mode 'rmail-mode) |
| 2215 | #'diary-from-outlook-rmail) | 2215 | #'diary-from-outlook-rmail) |
| 2216 | ((memq major-mode '(gnus-summary-mode gnus-article-mode)) | 2216 | ((memq major-mode '(gnus-summary-mode gnus-article-mode)) |
| 2217 | #'diary-from-outlook-gnus) | 2217 | #'diary-from-outlook-gnus) |
| 2218 | (t (error "Don't know how to snarf in `%s'" major-mode))))) | 2218 | (t (error "Don't know how to snarf in `%s'" major-mode))))) |
| 2219 | (funcall func noconfirm))) | 2219 | (funcall func noconfirm))) |
| 2220 | 2220 | ||
| 2221 | 2221 | ||
| @@ -2236,17 +2236,17 @@ automatically." | |||
| 2236 | (interactive "p") | 2236 | (interactive "p") |
| 2237 | (with-current-buffer gnus-article-buffer | 2237 | (with-current-buffer gnus-article-buffer |
| 2238 | (let ((subject (gnus-fetch-field "subject")) | 2238 | (let ((subject (gnus-fetch-field "subject")) |
| 2239 | (body (if gnus-article-mime-handles | 2239 | (body (if gnus-article-mime-handles |
| 2240 | ;; We're multipart. Don't get confused by part | 2240 | ;; We're multipart. Don't get confused by part |
| 2241 | ;; buttons &c. Assume info is in first part. | 2241 | ;; buttons &c. Assume info is in first part. |
| 2242 | (mm-get-part (nth 1 gnus-article-mime-handles)) | 2242 | (mm-get-part (nth 1 gnus-article-mime-handles)) |
| 2243 | (save-restriction | 2243 | (save-restriction |
| 2244 | (gnus-narrow-to-body) | 2244 | (gnus-narrow-to-body) |
| 2245 | (buffer-string))))) | 2245 | (buffer-string))))) |
| 2246 | (when (diary-from-outlook-internal t) | 2246 | (when (diary-from-outlook-internal t) |
| 2247 | (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) | 2247 | (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) |
| 2248 | (diary-from-outlook-internal) | 2248 | (diary-from-outlook-internal) |
| 2249 | (message "Diary entry added")))))) | 2249 | (message "Diary entry added")))))) |
| 2250 | 2250 | ||
| 2251 | (custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus) | 2251 | (custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus) |
| 2252 | 2252 | ||
| @@ -2261,14 +2261,14 @@ user is asked to confirm its addition." | |||
| 2261 | (interactive "p") | 2261 | (interactive "p") |
| 2262 | (with-current-buffer rmail-buffer | 2262 | (with-current-buffer rmail-buffer |
| 2263 | (let ((subject (mail-fetch-field "subject")) | 2263 | (let ((subject (mail-fetch-field "subject")) |
| 2264 | (body (buffer-substring (save-excursion | 2264 | (body (buffer-substring (save-excursion |
| 2265 | (rfc822-goto-eoh) | 2265 | (rfc822-goto-eoh) |
| 2266 | (point)) | 2266 | (point)) |
| 2267 | (point-max)))) | 2267 | (point-max)))) |
| 2268 | (when (diary-from-outlook-internal t) | 2268 | (when (diary-from-outlook-internal t) |
| 2269 | (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) | 2269 | (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) |
| 2270 | (diary-from-outlook-internal) | 2270 | (diary-from-outlook-internal) |
| 2271 | (message "Diary entry added")))))) | 2271 | (message "Diary entry added")))))) |
| 2272 | 2272 | ||
| 2273 | 2273 | ||
| 2274 | (provide 'diary-lib) | 2274 | (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, | |||
| 165 | ((= phase 2) (- adjustment adj)) | 165 | ((= phase 2) (- adjustment adj)) |
| 166 | (t adjustment))) | 166 | (t adjustment))) |
| 167 | (date (+ date adjustment)) | 167 | (date (+ date adjustment)) |
| 168 | (date (+ date (/ (- calendar-time-zone | 168 | (date (+ date (/ (- calendar-time-zone |
| 169 | (solar-ephemeris-correction | 169 | (solar-ephemeris-correction |
| 170 | (extract-calendar-year | 170 | (extract-calendar-year |
| 171 | (calendar-gregorian-from-absolute | 171 | (calendar-gregorian-from-absolute |
| 172 | (truncate date))))) | 172 | (truncate date))))) |
| 173 | 60.0 24.0))) | 173 | 60.0 24.0))) |
| 174 | (time (* 24 (- date (truncate date)))) | 174 | (time (* 24 (- date (truncate date)))) |
| 175 | (date (calendar-gregorian-from-absolute (truncate date))) | 175 | (date (calendar-gregorian-from-absolute (truncate date))) |
| 176 | (adj (dst-adjust-time date time))) | 176 | (adj (dst-adjust-time date time))) |
| 177 | (list (car adj) (apply 'solar-time-string (cdr adj)) phase))) | 177 | (list (car adj) (apply 'solar-time-string (cdr adj)) phase))) |
| 178 | 178 | ||
| @@ -261,103 +261,103 @@ use when highlighting the day in the calendar." | |||
| 261 | (defun lunar-new-moon-time (k) | 261 | (defun lunar-new-moon-time (k) |
| 262 | "Astronomical (Julian) day number of K th new moon." | 262 | "Astronomical (Julian) day number of K th new moon." |
| 263 | (let* ((T (/ k 1236.85)) | 263 | (let* ((T (/ k 1236.85)) |
| 264 | (T2 (* T T)) | 264 | (T2 (* T T)) |
| 265 | (T3 (* T T T)) | 265 | (T3 (* T T T)) |
| 266 | (T4 (* T2 T2)) | 266 | (T4 (* T2 T2)) |
| 267 | (JDE (+ 2451550.09765 | 267 | (JDE (+ 2451550.09765 |
| 268 | (* 29.530588853 k) | 268 | (* 29.530588853 k) |
| 269 | (* 0.0001337 T2) | 269 | (* 0.0001337 T2) |
| 270 | (* -0.000000150 T3) | 270 | (* -0.000000150 T3) |
| 271 | (* 0.00000000073 T4))) | 271 | (* 0.00000000073 T4))) |
| 272 | (E (- 1 (* 0.002516 T) (* 0.0000074 T2))) | 272 | (E (- 1 (* 0.002516 T) (* 0.0000074 T2))) |
| 273 | (sun-anomaly (+ 2.5534 | 273 | (sun-anomaly (+ 2.5534 |
| 274 | (* 29.10535669 k) | 274 | (* 29.10535669 k) |
| 275 | (* -0.0000218 T2) | 275 | (* -0.0000218 T2) |
| 276 | (* -0.00000011 T3))) | 276 | (* -0.00000011 T3))) |
| 277 | (moon-anomaly (+ 201.5643 | 277 | (moon-anomaly (+ 201.5643 |
| 278 | (* 385.81693528 k) | 278 | (* 385.81693528 k) |
| 279 | (* 0.0107438 T2) | 279 | (* 0.0107438 T2) |
| 280 | (* 0.00001239 T3) | 280 | (* 0.00001239 T3) |
| 281 | (* -0.000000058 T4))) | 281 | (* -0.000000058 T4))) |
| 282 | (moon-argument (+ 160.7108 | 282 | (moon-argument (+ 160.7108 |
| 283 | (* 390.67050274 k) | 283 | (* 390.67050274 k) |
| 284 | (* -0.0016341 T2) | 284 | (* -0.0016341 T2) |
| 285 | (* -0.00000227 T3) | 285 | (* -0.00000227 T3) |
| 286 | (* 0.000000011 T4))) | 286 | (* 0.000000011 T4))) |
| 287 | (omega (+ 124.7746 | 287 | (omega (+ 124.7746 |
| 288 | (* -1.56375580 k) | 288 | (* -1.56375580 k) |
| 289 | (* 0.0020691 T2) | 289 | (* 0.0020691 T2) |
| 290 | (* 0.00000215 T3))) | 290 | (* 0.00000215 T3))) |
| 291 | (A1 (+ 299.77 (* 0.107408 k) (* -0.009173 T2))) | 291 | (A1 (+ 299.77 (* 0.107408 k) (* -0.009173 T2))) |
| 292 | (A2 (+ 251.88 (* 0.016321 k))) | 292 | (A2 (+ 251.88 (* 0.016321 k))) |
| 293 | (A3 (+ 251.83 (* 26.641886 k))) | 293 | (A3 (+ 251.83 (* 26.641886 k))) |
| 294 | (A4 (+ 349.42 (* 36.412478 k))) | 294 | (A4 (+ 349.42 (* 36.412478 k))) |
| 295 | (A5 (+ 84.66 (* 18.206239 k))) | 295 | (A5 (+ 84.66 (* 18.206239 k))) |
| 296 | (A6 (+ 141.74 (* 53.303771 k))) | 296 | (A6 (+ 141.74 (* 53.303771 k))) |
| 297 | (A7 (+ 207.14 (* 2.453732 k))) | 297 | (A7 (+ 207.14 (* 2.453732 k))) |
| 298 | (A8 (+ 154.84 (* 7.306860 k))) | 298 | (A8 (+ 154.84 (* 7.306860 k))) |
| 299 | (A9 (+ 34.52 (* 27.261239 k))) | 299 | (A9 (+ 34.52 (* 27.261239 k))) |
| 300 | (A10 (+ 207.19 (* 0.121824 k))) | 300 | (A10 (+ 207.19 (* 0.121824 k))) |
| 301 | (A11 (+ 291.34 (* 1.844379 k))) | 301 | (A11 (+ 291.34 (* 1.844379 k))) |
| 302 | (A12 (+ 161.72 (* 24.198154 k))) | 302 | (A12 (+ 161.72 (* 24.198154 k))) |
| 303 | (A13 (+ 239.56 (* 25.513099 k))) | 303 | (A13 (+ 239.56 (* 25.513099 k))) |
| 304 | (A14 (+ 331.55 (* 3.592518 k))) | 304 | (A14 (+ 331.55 (* 3.592518 k))) |
| 305 | (correction | 305 | (correction |
| 306 | (+ (* -0.40720 (solar-sin-degrees moon-anomaly)) | 306 | (+ (* -0.40720 (solar-sin-degrees moon-anomaly)) |
| 307 | (* 0.17241 E (solar-sin-degrees sun-anomaly)) | 307 | (* 0.17241 E (solar-sin-degrees sun-anomaly)) |
| 308 | (* 0.01608 (solar-sin-degrees (* 2 moon-anomaly))) | 308 | (* 0.01608 (solar-sin-degrees (* 2 moon-anomaly))) |
| 309 | (* 0.01039 (solar-sin-degrees (* 2 moon-argument))) | 309 | (* 0.01039 (solar-sin-degrees (* 2 moon-argument))) |
| 310 | (* 0.00739 E (solar-sin-degrees (- moon-anomaly sun-anomaly))) | 310 | (* 0.00739 E (solar-sin-degrees (- moon-anomaly sun-anomaly))) |
| 311 | (* -0.00514 E (solar-sin-degrees (+ moon-anomaly sun-anomaly))) | 311 | (* -0.00514 E (solar-sin-degrees (+ moon-anomaly sun-anomaly))) |
| 312 | (* 0.00208 E E (solar-sin-degrees (* 2 sun-anomaly))) | 312 | (* 0.00208 E E (solar-sin-degrees (* 2 sun-anomaly))) |
| 313 | (* -0.00111 (solar-sin-degrees | 313 | (* -0.00111 (solar-sin-degrees |
| 314 | (- moon-anomaly (* 2 moon-argument)))) | 314 | (- moon-anomaly (* 2 moon-argument)))) |
| 315 | (* -0.00057 (solar-sin-degrees | 315 | (* -0.00057 (solar-sin-degrees |
| 316 | (+ moon-anomaly (* 2 moon-argument)))) | 316 | (+ moon-anomaly (* 2 moon-argument)))) |
| 317 | (* 0.00056 E (solar-sin-degrees | 317 | (* 0.00056 E (solar-sin-degrees |
| 318 | (+ (* 2 moon-anomaly) sun-anomaly))) | 318 | (+ (* 2 moon-anomaly) sun-anomaly))) |
| 319 | (* -0.00042 (solar-sin-degrees (* 3 moon-anomaly))) | 319 | (* -0.00042 (solar-sin-degrees (* 3 moon-anomaly))) |
| 320 | (* 0.00042 E (solar-sin-degrees | 320 | (* 0.00042 E (solar-sin-degrees |
| 321 | (+ sun-anomaly (* 2 moon-argument)))) | 321 | (+ sun-anomaly (* 2 moon-argument)))) |
| 322 | (* 0.00038 E (solar-sin-degrees | 322 | (* 0.00038 E (solar-sin-degrees |
| 323 | (- sun-anomaly (* 2 moon-argument)))) | 323 | (- sun-anomaly (* 2 moon-argument)))) |
| 324 | (* -0.00024 E (solar-sin-degrees | 324 | (* -0.00024 E (solar-sin-degrees |
| 325 | (- (* 2 moon-anomaly) sun-anomaly))) | 325 | (- (* 2 moon-anomaly) sun-anomaly))) |
| 326 | (* -0.00017 (solar-sin-degrees omega)) | 326 | (* -0.00017 (solar-sin-degrees omega)) |
| 327 | (* -0.00007 (solar-sin-degrees | 327 | (* -0.00007 (solar-sin-degrees |
| 328 | (+ moon-anomaly (* 2 sun-anomaly)))) | 328 | (+ moon-anomaly (* 2 sun-anomaly)))) |
| 329 | (* 0.00004 (solar-sin-degrees | 329 | (* 0.00004 (solar-sin-degrees |
| 330 | (- (* 2 moon-anomaly) (* 2 moon-argument)))) | 330 | (- (* 2 moon-anomaly) (* 2 moon-argument)))) |
| 331 | (* 0.00004 (solar-sin-degrees (* 3 sun-anomaly))) | 331 | (* 0.00004 (solar-sin-degrees (* 3 sun-anomaly))) |
| 332 | (* 0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly | 332 | (* 0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly |
| 333 | (* -2 moon-argument)))) | 333 | (* -2 moon-argument)))) |
| 334 | (* 0.00003 (solar-sin-degrees | 334 | (* 0.00003 (solar-sin-degrees |
| 335 | (+ (* 2 moon-anomaly) (* 2 moon-argument)))) | 335 | (+ (* 2 moon-anomaly) (* 2 moon-argument)))) |
| 336 | (* -0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly | 336 | (* -0.00003 (solar-sin-degrees (+ moon-anomaly sun-anomaly |
| 337 | (* 2 moon-argument)))) | 337 | (* 2 moon-argument)))) |
| 338 | (* 0.00003 (solar-sin-degrees (- moon-anomaly sun-anomaly | 338 | (* 0.00003 (solar-sin-degrees (- moon-anomaly sun-anomaly |
| 339 | (* -2 moon-argument)))) | 339 | (* -2 moon-argument)))) |
| 340 | (* -0.00002 (solar-sin-degrees (- moon-anomaly sun-anomaly | 340 | (* -0.00002 (solar-sin-degrees (- moon-anomaly sun-anomaly |
| 341 | (* 2 moon-argument)))) | 341 | (* 2 moon-argument)))) |
| 342 | (* -0.00002 (solar-sin-degrees | 342 | (* -0.00002 (solar-sin-degrees |
| 343 | (+ (* 3 moon-anomaly) sun-anomaly))) | 343 | (+ (* 3 moon-anomaly) sun-anomaly))) |
| 344 | (* 0.00002 (solar-sin-degrees (* 4 moon-anomaly))))) | 344 | (* 0.00002 (solar-sin-degrees (* 4 moon-anomaly))))) |
| 345 | (additional | 345 | (additional |
| 346 | (+ (* 0.000325 (solar-sin-degrees A1)) | 346 | (+ (* 0.000325 (solar-sin-degrees A1)) |
| 347 | (* 0.000165 (solar-sin-degrees A2)) | 347 | (* 0.000165 (solar-sin-degrees A2)) |
| 348 | (* 0.000164 (solar-sin-degrees A3)) | 348 | (* 0.000164 (solar-sin-degrees A3)) |
| 349 | (* 0.000126 (solar-sin-degrees A4)) | 349 | (* 0.000126 (solar-sin-degrees A4)) |
| 350 | (* 0.000110 (solar-sin-degrees A5)) | 350 | (* 0.000110 (solar-sin-degrees A5)) |
| 351 | (* 0.000062 (solar-sin-degrees A6)) | 351 | (* 0.000062 (solar-sin-degrees A6)) |
| 352 | (* 0.000060 (solar-sin-degrees A7)) | 352 | (* 0.000060 (solar-sin-degrees A7)) |
| 353 | (* 0.000056 (solar-sin-degrees A8)) | 353 | (* 0.000056 (solar-sin-degrees A8)) |
| 354 | (* 0.000047 (solar-sin-degrees A9)) | 354 | (* 0.000047 (solar-sin-degrees A9)) |
| 355 | (* 0.000042 (solar-sin-degrees A10)) | 355 | (* 0.000042 (solar-sin-degrees A10)) |
| 356 | (* 0.000040 (solar-sin-degrees A11)) | 356 | (* 0.000040 (solar-sin-degrees A11)) |
| 357 | (* 0.000037 (solar-sin-degrees A12)) | 357 | (* 0.000037 (solar-sin-degrees A12)) |
| 358 | (* 0.000035 (solar-sin-degrees A13)) | 358 | (* 0.000035 (solar-sin-degrees A13)) |
| 359 | (* 0.000023 (solar-sin-degrees A14)))) | 359 | (* 0.000023 (solar-sin-degrees A14)))) |
| 360 | (newJDE (+ JDE correction additional))) | 360 | (newJDE (+ JDE correction additional))) |
| 361 | (+ newJDE | 361 | (+ newJDE |
| 362 | (- (solar-ephemeris-correction | 362 | (- (solar-ephemeris-correction |
| 363 | (extract-calendar-year | 363 | (extract-calendar-year |
| @@ -377,8 +377,8 @@ calendar-time-zone." | |||
| 377 | (let* ((date (calendar-gregorian-from-absolute | 377 | (let* ((date (calendar-gregorian-from-absolute |
| 378 | (floor (calendar-absolute-from-astro d)))) | 378 | (floor (calendar-absolute-from-astro d)))) |
| 379 | (year (+ (extract-calendar-year date) | 379 | (year (+ (extract-calendar-year date) |
| 380 | (/ (calendar-day-number date) 365.25))) | 380 | (/ (calendar-day-number date) 365.25))) |
| 381 | (k (floor (* (- year 2000.0) 12.3685))) | 381 | (k (floor (* (- year 2000.0) 12.3685))) |
| 382 | (date (lunar-new-moon-time k))) | 382 | (date (lunar-new-moon-time k))) |
| 383 | (while (< date d) | 383 | (while (< date d) |
| 384 | (setq k (1+ k)) | 384 | (setq k (1+ k)) |