procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Update for calendar.el name changes.

Browse source
This commit is contained in:
Glenn Morris 2008-04-07 01:59:37 +00:00
parent 1b73d7f379
commit e803eab777
19 changed files with 407 additions and 398 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
lisp/calendar/cal-bahai.el
View file

@ -79,9 +79,9 @@ Used by `calendar-bahai-to-absolute'.")
"Compute absolute date from Bahá'í date DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let* ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(let* ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
(prior-years (+ (1- year) 1844))
(leap-days (- (+ (/ prior-years 4) ; leap days in prior years
(- (/ prior-years 100))
@ -104,11 +104,11 @@ Gregorian date Sunday, December 31, 1 BC."
(if (< date calendar-bahai-epoch)
(list 0 0 0) ; pre-Bahá'í date
(let* ((greg (calendar-gregorian-from-absolute date))
(gmonth (extract-calendar-month greg))
(year (+ (- (extract-calendar-year greg) 1844)
(gmonth (calendar-extract-month greg))
(year (+ (- (calendar-extract-year greg) 1844)
(if (or (> gmonth 3)
(and (= gmonth 3)
(>= (extract-calendar-day greg) 21)))
(>= (calendar-extract-day greg) 21)))
1 0)))
(month ; search forward from Baha
(1+ (calendar-sum m 1
@ -126,11 +126,11 @@ Defaults to today's date if DATE is not given."
(let* ((bahai-date (calendar-bahai-from-absolute
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(y (extract-calendar-year bahai-date)))
(y (calendar-extract-year bahai-date)))
(if (< y 1)
"" ; pre-Bahai
(let* ((m (extract-calendar-month bahai-date))
(d (extract-calendar-day bahai-date))
(let* ((m (calendar-extract-month bahai-date))
(d (calendar-extract-day bahai-date))
(monthname (if (and (= m 19)
(<= d 0))
"Ayyám-i-Há"
@ -165,7 +165,7 @@ Reads a year, month and day."
"Bahá'í calendar year (not 0): "
(lambda (x) (not (zerop x)))
(int-to-string
(extract-calendar-year
(calendar-extract-year
(calendar-bahai-from-absolute
(calendar-absolute-from-gregorian today))))))
(completion-ignore-case t)
@ -210,8 +210,8 @@ nil if it is not visible in the current calendar window."
(let* ((bahai-date (calendar-bahai-from-absolute
(calendar-absolute-from-gregorian
(list displayed-month 15 displayed-year))))
(m (extract-calendar-month bahai-date))
(y (extract-calendar-year bahai-date))
(m (calendar-extract-month bahai-date))
(y (calendar-extract-year bahai-date))
date)
(unless (< m 1) ; Bahá'í calendar doesn't apply
;; Cf holiday-fixed, holiday-islamic.
@ -222,7 +222,7 @@ nil if it is not visible in the current calendar window."
;; m16 is visible. m16 is visible when the central month >= 13.
;; To see if other months are visible we can shift the range
;; accordingly.
(increment-calendar-month m y (- 16 month) 19)
(calendar-increment-month m y (- 16 month) 19)
(and (> m 12) ; Bahá'í date might be visible
(calendar-date-is-visible-p
(setq date (calendar-gregorian-from-absolute
@ -282,7 +282,7 @@ will not be marked in the calendar. This function is provided for use with
(defun calendar-bahai-mark-date-pattern (month day year &optional color)
"Mark dates in calendar window that conform to Bahá'í date MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard. Optional argument COLOR is
passed to `mark-visible-calendar-date' as MARK."
passed to `calendar-mark-visible-date' as MARK."
(calendar-mark-1 month day year 'calendar-bahai-from-absolute
'calendar-bahai-to-absolute color))

14
lisp/calendar/cal-china.el
View file

@ -213,7 +213,7 @@ N congruent to 1 gives the first name, N congruent to 2 gives the second name,
(defun calendar-chinese-zodiac-sign-on-or-after (d)
"Absolute date of first new Zodiac sign on or after absolute date D.
The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
(let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d)))
(let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
(calendar-time-zone (eval calendar-chinese-time-zone)) ; uses year
(calendar-daylight-time-offset
calendar-chinese-daylight-time-offset)
@ -235,7 +235,7 @@ The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
(defun calendar-chinese-new-moon-on-or-after (d)
"Absolute date of first new moon on or after absolute date D."
(let* ((year (extract-calendar-year (calendar-gregorian-from-absolute d)))
(let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
(calendar-time-zone (eval calendar-chinese-time-zone))
(calendar-daylight-time-offset
calendar-chinese-daylight-time-offset)
@ -434,7 +434,7 @@ Sunday, December 31, 1 BC is imaginary."
"Compute Chinese date (cycle year month day) corresponding to absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let* ((g-year (extract-calendar-year
(let* ((g-year (calendar-extract-year
(calendar-gregorian-from-absolute date)))
(c-year (+ g-year 2695))
(list (append (calendar-chinese-year (1- g-year))
@ -454,7 +454,7 @@ Gregorian date Sunday, December 31, 1 BC."
(caar list)
(1+ (- date (cadr (car list)))))))
;; Bound in generate-calendar.
;; Bound in calendar-generate.
(defvar displayed-month)
(defvar displayed-year)
@ -469,7 +469,7 @@ Returns (((MONTH DAY YEAR) TEXT)), where the date is Gregorian."
;; Jan is visible if displayed-month = 12, 1, 2; Feb if d-m = 1, 2, 3.
;; If we shift the calendar forward one month, we can do a
;; one-sided test, namely: d-m <= 4 means CNY might be visible.
(increment-calendar-month m y 1) ; shift forward a month
(calendar-increment-month m y 1) ; shift forward a month
(and (< m 5)
(calendar-date-is-visible-p
(setq chinese-new-year
@ -546,13 +546,13 @@ Defaults to today's date if DATE is not given."
(memq 1 (append
(mapcar (lambda (x)
(car x))
(calendar-chinese-year (extract-calendar-year
(calendar-chinese-year (calendar-extract-year
(calendar-gregorian-from-absolute
(calendar-chinese-to-absolute
(list c y 1 1))))))
(mapcar (lambda (x)
(if (> (car x) 11) (car x)))
(calendar-chinese-year (extract-calendar-year
(calendar-chinese-year (calendar-extract-year
(calendar-gregorian-from-absolute
(calendar-chinese-to-absolute
(list (if (= y 60) (1+ c) c)

14
lisp/calendar/cal-coptic.el
View file

@ -68,9 +68,9 @@ Nisi (Kebus) at the end of the year."
"Compute absolute date from Coptic date DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
(let ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date)))
(+ (1- calendar-coptic-epoch) ; days before start of calendar
(* 365 (1- year)) ; days in prior years
(/ year 4) ; leap days in prior years
@ -117,12 +117,12 @@ Defaults to today's date if DATE is not given."
(let* ((coptic-date (calendar-coptic-from-absolute
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(y (extract-calendar-year coptic-date))
(m (extract-calendar-month coptic-date)))
(y (calendar-extract-year coptic-date))
(m (calendar-extract-month coptic-date)))
(if (< y 1)
""
(let ((monthname (aref calendar-coptic-month-name-array (1- m)))
(day (int-to-string (extract-calendar-day coptic-date)))
(day (int-to-string (calendar-extract-day coptic-date)))
(dayname nil)
(month (int-to-string m))
(year (int-to-string y)))
@ -148,7 +148,7 @@ Reads a year, month, and day."
(format "%s calendar year (>0): " calendar-coptic-name)
(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-extract-year
(calendar-coptic-from-absolute
(calendar-absolute-from-gregorian today))))))
(completion-ignore-case t)

8
lisp/calendar/cal-dst.el
View file

@ -189,9 +189,9 @@ ABS-DATE must specify a day that contains a daylight saving transition.
The result has the proper form for `calendar-daylight-savings-starts'."
(let* ((date (calendar-gregorian-from-absolute abs-date))
(weekday (% abs-date 7))
(m (extract-calendar-month date))
(d (extract-calendar-day date))
(y (extract-calendar-year date))
(m (calendar-extract-month date))
(d (calendar-extract-day date))
(y (calendar-extract-year date))
(last (calendar-last-day-of-month m y))
j rlist
(candidate-rules ; these return Gregorian dates
@ -423,7 +423,7 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
(defun dst-in-effect (date)
"True if on absolute DATE daylight saving time is in effect.
Fractional part of DATE is local standard time of day."
(let* ((year (extract-calendar-year
(let* ((year (calendar-extract-year
(calendar-gregorian-from-absolute (floor date))))
(dst-starts-gregorian (eval calendar-daylight-savings-starts))
(dst-ends-gregorian (eval calendar-daylight-savings-ends))

14
lisp/calendar/cal-french.el
View file

@ -114,9 +114,9 @@ The 13th month is not really a month, but the 5 (6 in leap years) day period of
"Compute absolute date from French Revolutionary date DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
(let ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date)))
(+ (* 365 (1- year)) ; days in prior years
;; Leap days in prior years.
(if (< year 20)
@ -170,9 +170,9 @@ Defaults to today's date if DATE is not given."
(let* ((french-date (calendar-french-from-absolute
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(y (extract-calendar-year french-date))
(m (extract-calendar-month french-date))
(d (extract-calendar-day french-date)))
(y (calendar-extract-year french-date))
(m (calendar-extract-month french-date))
(d (calendar-extract-day french-date)))
(cond
((< y 1) "")
((= m 13) (format (if (calendar-french-accents-p)
@ -214,7 +214,7 @@ Echo French Revolutionary date unless NOECHO is non-nil."
"Anne'e de la Re'volution (>0): ")
(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-extract-year
(calendar-french-from-absolute
(calendar-absolute-from-gregorian
(calendar-current-date))))))))

82
lisp/calendar/cal-hebrew.el
View file

@ -119,9 +119,9 @@ Measured from Sunday before start of Hebrew calendar."
"Absolute date of Hebrew DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
(let ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date)))
(+ day ; days so far this month
(if (< month 7) ; before Tishri
;; Then add days in prior months this year before and after Nisan.
@ -146,9 +146,9 @@ Gregorian date Sunday, December 31, 1 BC."
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let* ((greg-date (calendar-gregorian-from-absolute date))
(year (+ 3760 (extract-calendar-year greg-date)))
(year (+ 3760 (calendar-extract-year greg-date)))
(month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
(1- (extract-calendar-month greg-date))))
(1- (calendar-extract-month greg-date))))
(length (progn
(while (>= date (calendar-hebrew-to-absolute
(list 7 1 (1+ year))))
@ -184,7 +184,7 @@ Driven by the variable `calendar-date-display-form'."
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(calendar-month-name-array
(if (calendar-hebrew-leap-year-p (extract-calendar-year hebrew-date))
(if (calendar-hebrew-leap-year-p (calendar-extract-year hebrew-date))
calendar-hebrew-month-name-array-leap-year
calendar-hebrew-month-name-array-common-year)))
(calendar-date-string hebrew-date nil t)))
@ -201,9 +201,9 @@ Driven by the variable `calendar-date-display-form'."
(defun calendar-hebrew-yahrzeit (death-date year)
"Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
(let ((death-day (extract-calendar-day death-date))
(death-month (extract-calendar-month death-date))
(death-year (extract-calendar-year death-date)))
(let ((death-day (calendar-extract-day death-date))
(death-month (calendar-extract-month death-date))
(death-year (calendar-extract-year death-date)))
(cond
;; If it's Heshvan 30 it depends on the first anniversary; if
;; that was not Heshvan 30, use the day before Kislev 1.
@ -243,7 +243,7 @@ Reads a year, month, and day."
"Hebrew calendar year (>3760): "
(lambda (x) (> x 3760))
(int-to-string
(extract-calendar-year
(calendar-extract-year
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian today))))))
(month-array (if (calendar-hebrew-leap-year-p year)
@ -289,7 +289,7 @@ Reads a year, month, and day."
(define-obsolete-function-alias 'calendar-goto-hebrew-date
'calendar-hebrew-goto-date "23.1")
(defvar displayed-month) ; from generate-calendar
(defvar displayed-month) ; from calendar-generate
(defun calendar-hebrew-date-is-visible-p (month day)
"Return non-nil if Hebrew MONTH DAY is visible in the calendar window.
@ -413,8 +413,8 @@ is non-nil."
(let* ((m displayed-month)
(y displayed-year)
(h-y (progn
(increment-calendar-month m y 1)
(extract-calendar-year
(calendar-increment-month m y 1)
(calendar-extract-year
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(list m (calendar-last-day-of-month m y) y))))))
@ -561,8 +561,8 @@ Kiddush HaHamah."
(holiday-julian
11
(progn
(increment-calendar-month m y -1)
(setq year (extract-calendar-year
(calendar-increment-month m y -1)
(setq year (calendar-extract-year
(calendar-julian-from-absolute
(calendar-absolute-from-gregorian (list m 1 y)))))
(if (zerop (% (1+ year) 4))
@ -571,7 +571,7 @@ Kiddush HaHamah."
(holiday-hebrew
10
(progn
(setq h-year (extract-calendar-year
(setq h-year (calendar-extract-year
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(list displayed-month 28 displayed-year)))))
@ -586,8 +586,8 @@ Kiddush HaHamah."
(setq m displayed-month
y displayed-year
h-year (progn
(increment-calendar-month m y 1)
(extract-calendar-year
(calendar-increment-month m y 1)
(calendar-extract-year
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(list m (calendar-last-day-of-month m y) y)))))
@ -603,14 +603,14 @@ Kiddush HaHamah."
(calendar-dayname-on-or-before
6 (calendar-hebrew-to-absolute
(list 11 16 h-year))))))
(extract-calendar-day s-s))
(calendar-extract-day s-s))
"Shabbat Shirah")
(and (progn
(setq m displayed-month
y displayed-year
year (progn
(increment-calendar-month m y -1)
(extract-calendar-year
(calendar-increment-month m y -1)
(calendar-extract-year
(calendar-julian-from-absolute
(calendar-absolute-from-gregorian (list m 1 y))))))
(= 21 (% year 28)))
@ -645,7 +645,7 @@ is provided for use with `diary-nongregorian-listing-hook'."
(defun calendar-hebrew-mark-date-pattern (month day year &optional color)
"Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard. Optional argument COLOR is
passed to `mark-visible-calendar-date' as MARK."
passed to `calendar-mark-visible-date' as MARK."
;; FIXME not the same as the Bahai and Islamic cases, so can't use
;; calendar-mark-1.
(save-excursion
@ -657,10 +657,10 @@ passed to `mark-visible-calendar-date' as MARK."
(calendar-hebrew-to-absolute
(list month day year)))))
(if (calendar-date-is-visible-p date)
(mark-visible-calendar-date date color)))
(calendar-mark-visible-date date color)))
;; Month and day in any year.
(let ((gdate (calendar-hebrew-date-is-visible-p month day)))
(if gdate (mark-visible-calendar-date gdate color))))
(if gdate (calendar-mark-visible-date gdate color))))
(calendar-mark-complex month day year
'calendar-hebrew-from-absolute color))))
@ -738,7 +738,7 @@ from the cursor position."
(year (calendar-read
"Year of death (>0): "
(lambda (x) (> x 0))
(int-to-string (extract-calendar-year today))))
(int-to-string (calendar-extract-year today))))
(month-array calendar-month-name-array)
(completion-ignore-case t)
(month (cdr (assoc-string
@ -752,7 +752,7 @@ from the cursor position."
(format "Day of death (1-%d): " last)
(lambda (x) (and (< 0 x) (<= x last))))))
(list month day year))))
(death-year (extract-calendar-year death-date))
(death-year (calendar-extract-year death-date))
(start-year (calendar-read
(format "Starting year of Yahrzeit table (>%d): "
death-year)
@ -766,11 +766,11 @@ from the cursor position."
(message "Computing Yahrzeits...")
(let* ((h-date (calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian death-date)))
(h-month (extract-calendar-month h-date))
(h-day (extract-calendar-day h-date))
(h-year (extract-calendar-year h-date))
(h-month (calendar-extract-month h-date))
(h-day (calendar-extract-day h-date))
(h-year (calendar-extract-year h-date))
(i (1- start-year)))
(calendar-in-read-only-buffer cal-hebrew-yahrzeit-buffer
(calendar-in-read-only-buffer calendar-hebrew-yahrzeit-buffer
(calendar-set-mode-line
(format "Yahrzeit dates for %s = %s"
(calendar-date-string death-date)
@ -785,7 +785,7 @@ from the cursor position."
(calendar-gregorian-from-absolute
(calendar-hebrew-yahrzeit
h-date
(extract-calendar-year
(calendar-extract-year
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian (list 1 1 i))))))) "\n"))))
(message "Computing Yahrzeits...done"))
@ -811,7 +811,7 @@ An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(let* ((passover
(calendar-hebrew-to-absolute
(list 1 15 (+ (extract-calendar-year date) 3760))))
(list 1 15 (+ (calendar-extract-year date) 3760))))
(omer (- (calendar-absolute-from-gregorian date) passover))
(week (/ omer 7))
(day (% omer 7)))
@ -851,11 +851,11 @@ use when highlighting the day in the calendar."
(let* ((h-date (calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(diary-make-date death-month death-day death-year))))
(h-month (extract-calendar-month h-date))
(h-day (extract-calendar-day h-date))
(h-year (extract-calendar-year h-date))
(h-month (calendar-extract-month h-date))
(h-day (calendar-extract-day h-date))
(h-year (calendar-extract-year h-date))
(d (calendar-absolute-from-gregorian date))
(yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
(yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
(diff (- yr h-year))
(y (calendar-hebrew-yahrzeit h-date yr)))
(if (and (> diff 0) (or (= y d) (= y (1+ d))))
@ -880,9 +880,9 @@ An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(let* ((d (calendar-absolute-from-gregorian date))
(h-date (calendar-hebrew-from-absolute d))
(h-month (extract-calendar-month h-date))
(h-day (extract-calendar-day h-date))
(h-year (extract-calendar-year h-date))
(h-month (calendar-extract-month h-date))
(h-day (calendar-extract-day h-date))
(h-year (calendar-extract-year h-date))
(leap-year (calendar-hebrew-leap-year-p h-year))
(last-day (calendar-hebrew-last-day-of-month h-month h-year))
(h-month-names
@ -890,7 +890,7 @@ use when highlighting the day in the calendar."
calendar-hebrew-month-name-array-leap-year
calendar-hebrew-month-name-array-common-year))
(this-month (aref h-month-names (1- h-month)))
(h-yesterday (extract-calendar-day
(h-yesterday (calendar-extract-day
(calendar-hebrew-from-absolute (1- d)))))
(if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
(cons mark
@ -1082,7 +1082,7 @@ An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(let ((d (calendar-absolute-from-gregorian date)))
(if (= (% d 7) 6) ; Saturday
(let* ((h-year (extract-calendar-year
(let* ((h-year (calendar-extract-year
(calendar-hebrew-from-absolute d)))
(rosh-hashanah
(calendar-hebrew-to-absolute (list 7 1 h-year)))

14
lisp/calendar/cal-html.el
View file

@ -207,15 +207,15 @@ Contains links to previous and next month and year, and current minical."
(insert (cal-html-b-table "class=header"))
(insert cal-html-b-tablerow-string)
(insert cal-html-b-tabledata-string) ; month links
(increment-calendar-month month year -1) ; previous month
(calendar-increment-month month year -1) ; previous month
(cal-html-insert-link-monthpage month year t) ; t --> change-dir
(increment-calendar-month month year 1) ; current month
(calendar-increment-month month year 1) ; current month
(cal-html-insert-link-yearpage month year)
(increment-calendar-month month year 1) ; next month
(calendar-increment-month month year 1) ; next month
(cal-html-insert-link-monthpage month year t) ; t --> change-dir
(insert cal-html-e-tabledata-string)
(insert cal-html-b-tabledata-string) ; minical
(increment-calendar-month month year -1)
(calendar-increment-month month year -1)
(cal-html-insert-minical month year)
(insert cal-html-e-tabledata-string)
(insert cal-html-e-tablerow-string) ; end
@ -418,8 +418,8 @@ The output directory DIR is created if necessary. Interactively,
MONTH and YEAR are taken from the calendar cursor position. Note
that any existing output files are overwritten."
(interactive (let* ((date (calendar-cursor-to-date t))
(month (extract-calendar-month date))
(year (extract-calendar-year date)))
(month (calendar-extract-month date))
(year (calendar-extract-year date)))
(list month year (cal-html-year-dir-ask-user year))))
(make-directory dir t)
(cal-html-one-month month year dir))
@ -430,7 +430,7 @@ that any existing output files are overwritten."
The output directory DIR is created if necessary. Interactively,
YEAR is taken from the calendar cursor position. Note that any
existing output files are overwritten."
(interactive (let ((year (extract-calendar-year
(interactive (let ((year (calendar-extract-year
(calendar-cursor-to-date t))))
(list year (cal-html-year-dir-ask-user year))))
(make-directory dir t)

28
lisp/calendar/cal-islam.el
View file

@ -59,18 +59,18 @@
(defun calendar-islamic-day-number (date)
"Return the day number within the year of the Islamic date DATE."
(let ((month (extract-calendar-month date)))
(let ((month (calendar-extract-month date)))
(+ (* 30 (/ month 2))
(* 29 (/ (1- month) 2))
(extract-calendar-day date))))
(calendar-extract-day date))))
(defun calendar-islamic-to-absolute (date)
"Absolute date of Islamic DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let* ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(let* ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
(y (% year 30))
(leap-years-in-cycle (cond ((< y 3) 0)
((< y 6) 1)
@ -130,7 +130,7 @@ Driven by the variable `calendar-date-display-form'."
(islamic-date (calendar-islamic-from-absolute
(calendar-absolute-from-gregorian
(or date (calendar-current-date))))))
(if (< (extract-calendar-year islamic-date) 1)
(if (< (calendar-extract-year islamic-date) 1)
""
(calendar-date-string islamic-date nil t))))
@ -154,7 +154,7 @@ Reads a year, month, and day."
"Islamic calendar year (>0): "
(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-extract-year
(calendar-islamic-from-absolute
(calendar-absolute-from-gregorian today))))))
(month-array calendar-islamic-month-name-array)
@ -182,7 +182,7 @@ Reads a year, month, and day."
(define-obsolete-function-alias 'calendar-goto-islamic-date
'calendar-islamic-goto-date "23.1")
(defvar displayed-month) ; from generate-calendar
(defvar displayed-month) ; from calendar-generate
(defvar displayed-year)
;;;###holiday-autoload
@ -199,8 +199,8 @@ nil if it is not visible in the current calendar window."
(let* ((islamic-date (calendar-islamic-from-absolute
(calendar-absolute-from-gregorian
(list displayed-month 15 displayed-year))))
(m (extract-calendar-month islamic-date))
(y (extract-calendar-year islamic-date))
(m (calendar-extract-month islamic-date))
(y (calendar-extract-year islamic-date))
date)
(unless (< m 1) ; Islamic calendar doesn't apply
;; Since converting to absolute dates can be a complex
@ -220,7 +220,7 @@ nil if it is not visible in the current calendar window."
;; Hence to test if any given month might be visible, we can
;; shift things and ask about October.
;; At the same time, we work out the appropriate year y to use.
(increment-calendar-month m y (- 10 month))
(calendar-increment-month m y (- 10 month))
(and (> m 7) ; Islamic date might be visible
(calendar-date-is-visible-p
(setq date (calendar-gregorian-from-absolute
@ -237,8 +237,8 @@ nil if it is not visible in the current calendar window."
(list (list date
(format "Islamic New Year %d"
(progn
(increment-calendar-month m y 1)
(extract-calendar-year
(calendar-increment-month m y 1)
(calendar-extract-year
(calendar-islamic-from-absolute
(calendar-absolute-from-gregorian
(list m (calendar-last-day-of-month m y) y)
@ -271,7 +271,7 @@ marked in the calendar. This function is provided for use with
(defun calendar-islamic-mark-date-pattern (month day year &optional color)
"Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard. Optional argument COLOR is
passed to `mark-visible-calendar-date' as MARK."
passed to `calendar-mark-visible-date' as MARK."
(calendar-mark-1 month day year 'calendar-islamic-from-absolute
'calendar-islamic-to-absolute color))

16
lisp/calendar/cal-iso.el
View file

@ -41,12 +41,12 @@ the first such week in which at least 4 days are in a year. The ISO
commercial DATE has the form (week day year) in which week is in the range
1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 =
Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary."
(let ((day (extract-calendar-day date)))
(let ((day (calendar-extract-day date)))
(+ (calendar-dayname-on-or-before
1 (+ 3 (calendar-absolute-from-gregorian
(list 1 1 (extract-calendar-year date)))))
(list 1 1 (calendar-extract-year date)))))
;; ISO date is (week day year); normally (month day year).
(* 7 (1- (extract-calendar-month date)))
(* 7 (1- (calendar-extract-month date)))
(if (zerop day) 6 (1- day)))))
(define-obsolete-function-alias 'calendar-absolute-from-iso
@ -61,7 +61,7 @@ date has the form (week day year) in which week is in the range 1..52 and
day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = Sunday). The
absolute date is the number of days elapsed since the (imaginary) Gregorian
date Sunday, December 31, 1 BC."
(let* ((approx (extract-calendar-year
(let* ((approx (calendar-extract-year
(calendar-gregorian-from-absolute (- date 3))))
(year (+ approx
(calendar-sum y approx
@ -82,8 +82,8 @@ date Sunday, December 31, 1 BC."
(iso-date (calendar-iso-from-absolute d)))
(format "Day %s of week %d of %d"
(if (zerop day) 7 day)
(extract-calendar-month iso-date)
(extract-calendar-year iso-date))))
(calendar-extract-month iso-date)
(calendar-extract-year iso-date))))
;;;###cal-autoload
(defun calendar-iso-print-date ()
@ -102,9 +102,9 @@ taken to be 1)."
(let* ((year (calendar-read
"ISO calendar year (>0): "
(lambda (x) (> x 0))
(int-to-string (extract-calendar-year
(int-to-string (calendar-extract-year
(calendar-current-date)))))
(no-weeks (extract-calendar-month
(no-weeks (calendar-extract-month
(calendar-iso-from-absolute
(1-
(calendar-dayname-on-or-before

6
lisp/calendar/cal-julian.el
View file

@ -36,8 +36,8 @@
(defun calendar-julian-to-absolute (date)
"The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
The Gregorian date Sunday, December 31, 1 BC is imaginary."
(let ((month (extract-calendar-month date))
(year (extract-calendar-year date)))
(let ((month (calendar-extract-month date))
(year (calendar-extract-year date)))
(+ (calendar-day-number date)
(if (and (zerop (% year 100))
(not (zerop (% year 400)))
@ -107,7 +107,7 @@ Driven by the variable `calendar-date-display-form'."
"Julian calendar year (>0): "
(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-extract-year
(calendar-julian-from-absolute
(calendar-absolute-from-gregorian
today))))))

18
lisp/calendar/cal-menu.el
View file

@ -66,8 +66,8 @@
(defun cal-menu-holiday-window-suffix ()
"Return a string suffix for the \"Window\" entry in `cal-menu-holidays-menu'."
(let ((my1 (calendar-increment-month -1))
(my2 (calendar-increment-month 1)))
(let ((my1 (calendar-increment-month-cons -1))
(my2 (calendar-increment-month-cons 1)))
(if (= (cdr my1) (cdr my2))
(format "%s-%s, %d"
(calendar-month-name (car my1) 'abbrev)
@ -79,7 +79,7 @@
(calendar-month-name (car my2) 'abbrev)
(cdr my2)))))
(defvar displayed-year) ; from generate-calendar
(defvar displayed-year) ; from calendar-generate
(defconst cal-menu-holidays-menu
`("Holidays"
@ -160,17 +160,17 @@ POSITION and MENU are passed to `x-popup-menu'."
(defun cal-menu-list-holidays-year ()
"Display a list of the holidays of the selected date's year."
(interactive)
(holiday-list (extract-calendar-year (calendar-cursor-to-date))))
(holiday-list (calendar-extract-year (calendar-cursor-to-date))))
(defun cal-menu-list-holidays-following-year ()
"Display a list of the holidays of the following year."
(interactive)
(holiday-list (1+ (extract-calendar-year (calendar-cursor-to-date)))))
(holiday-list (1+ (calendar-extract-year (calendar-cursor-to-date)))))
(defun cal-menu-list-holidays-previous-year ()
"Display a list of the holidays of the previous year."
(interactive)
(holiday-list (1- (extract-calendar-year (calendar-cursor-to-date)))))
(holiday-list (1- (calendar-extract-year (calendar-cursor-to-date)))))
(defun calendar-event-to-date (&optional error)
"Date of last event.
@ -218,12 +218,12 @@ EVENT is the event that invoked this command."
(and selection (call-interactively selection))))
(autoload 'diary-list-entries "diary-lib")
(defvar holidays-in-diary-buffer) ; only called from calendar.el
(defvar diary-show-holidays-flag) ; only called from calendar.el
(defun calendar-mouse-view-diary-entries (&optional date diary event)
"Pop up menu of diary entries for mouse-selected date.
Use optional DATE and alternative file DIARY. EVENT is the event
that invoked this command. Shows holidays if `holidays-in-diary-buffer'
that invoked this command. Shows holidays if `diary-show-holidays-flag'
is non-nil."
(interactive "i\ni\ne")
(let* ((date (or date (calendar-event-to-date)))
@ -233,7 +233,7 @@ is non-nil."
(diary-entries
(mapcar (lambda (x) (split-string (cadr x) "\n"))
(diary-list-entries date 1 'list-only)))
(holidays (if holidays-in-diary-buffer
(holidays (if diary-show-holidays-flag
(calendar-check-holidays date)))
(title (concat "Diary entries "
(if diary (format "from %s " diary) "")

60
lisp/calendar/cal-move.el
View file

@ -56,15 +56,15 @@ Returns the list (month day year) giving the cursor position."
(re-search-backward "[0-9]" nil t)))
(calendar-cursor-to-date))))
(defvar displayed-month) ; from generate-calendar
(defvar displayed-month) ; from calendar-generate
(defvar displayed-year)
;;;###cal-autoload
(defun calendar-cursor-to-visible-date (date)
"Move the cursor to DATE that is on the screen."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
(let ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date)))
(goto-line (+ 3
(/ (+ day -1
(mod
@ -87,8 +87,8 @@ Returns the list (month day year) giving the cursor position."
(interactive)
(let ((today (calendar-current-date))) ; the date might have changed
(if (not (calendar-date-is-visible-p today))
(generate-calendar-window)
(update-calendar-mode-line)
(calendar-generate-window)
(calendar-update-mode-line)
(calendar-cursor-to-visible-date today)))
(run-hooks 'calendar-move-hook))
@ -99,11 +99,11 @@ Movement is backward if ARG is negative."
(interactive "p")
(calendar-cursor-to-nearest-date)
(let* ((cursor-date (calendar-cursor-to-date t))
(month (extract-calendar-month cursor-date))
(day (extract-calendar-day cursor-date))
(year (extract-calendar-year cursor-date))
(month (calendar-extract-month cursor-date))
(day (calendar-extract-day cursor-date))
(year (calendar-extract-year cursor-date))
(last (progn
(increment-calendar-month month year arg)
(calendar-increment-month month year arg)
(calendar-last-day-of-month month year)))
(day (min last day))
;; Put the new month on the screen, if needed, and go to the new date.
@ -151,8 +151,8 @@ EVENT is an event like `last-nonmenu-event'."
(today (calendar-current-date))
(month displayed-month)
(year displayed-year))
(increment-calendar-month month year arg)
(generate-calendar-window month year)
(calendar-increment-month month year arg)
(calendar-generate-window month year)
(calendar-cursor-to-visible-date
(cond
((calendar-date-is-visible-p old-date) old-date)
@ -211,8 +211,8 @@ Moves backward if ARG is negative."
(new-cursor-date
(calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian cursor-date) arg)))
(new-display-month (extract-calendar-month new-cursor-date))
(new-display-year (extract-calendar-year new-cursor-date)))
(new-display-month (calendar-extract-month new-cursor-date))
(new-display-year (calendar-extract-year new-cursor-date)))
;; Put the new month on the screen, if needed, and go to the new date.
(if (not (calendar-date-is-visible-p new-cursor-date))
(calendar-other-month new-display-month new-display-year))
@ -270,9 +270,9 @@ Moves forward if ARG is negative."
(interactive "p")
(calendar-cursor-to-nearest-date)
(let* ((date (calendar-cursor-to-date))
(month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
(month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date)))
(if (= day 1)
(calendar-backward-month arg)
(calendar-cursor-to-visible-date (list month 1 year))
@ -284,16 +284,16 @@ Moves forward if ARG is negative."
(interactive "p")
(calendar-cursor-to-nearest-date)
(let* ((date (calendar-cursor-to-date))
(month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
(last-day (calendar-last-day-of-month month year))
(last-day (progn
(unless (= day last-day)
(calendar-cursor-to-visible-date
(list month last-day year))
(setq arg (1- arg)))
(increment-calendar-month month year arg)
(calendar-increment-month month year arg)
(list month
(calendar-last-day-of-month month year)
year))))
@ -308,9 +308,9 @@ Moves forward if ARG is negative."
(interactive "p")
(calendar-cursor-to-nearest-date)
(let* ((date (calendar-cursor-to-date))
(month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
(jan-first (list 1 1 year))
(calendar-move-hook nil))
(if (and (= day 1) (= 1 month))
@ -328,9 +328,9 @@ Moves forward if ARG is negative."
(interactive "p")
(calendar-cursor-to-nearest-date)
(let* ((date (calendar-cursor-to-date))
(month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
(dec-31 (list 12 31 year))
(calendar-move-hook nil))
(if (and (= day 31) (= 12 month))
@ -346,8 +346,8 @@ Moves forward if ARG is negative."
(defun calendar-goto-date (date)
"Move cursor to DATE."
(interactive (list (calendar-read-date)))
(let ((month (extract-calendar-month date))
(year (extract-calendar-year date)))
(let ((month (calendar-extract-month date))
(year (calendar-extract-year date)))
(if (not (calendar-date-is-visible-p date))
(calendar-other-month
(if (and (= month 1) (= year 1))
@ -365,7 +365,7 @@ Negative DAY counts backward from end of year."
(let* ((year (calendar-read
"Year (>0): "
(lambda (x) (> x 0))
(int-to-string (extract-calendar-year
(int-to-string (calendar-extract-year
(calendar-current-date)))))
(last (if (calendar-leap-year-p year) 366 365))
(day (calendar-read

14
lisp/calendar/cal-persia.el
View file

@ -67,9 +67,9 @@
"Compute absolute date from Persian date DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
(let ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date)))
(if (< year 0)
(+ (calendar-persian-to-absolute
(list month day (1+ (mod year 2820))))
@ -149,10 +149,10 @@ Gregorian date Sunday, December 31, 1 BC."
(let* ((persian-date (calendar-persian-from-absolute
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(y (extract-calendar-year persian-date))
(m (extract-calendar-month persian-date))
(y (calendar-extract-year persian-date))
(m (calendar-extract-month persian-date))
(monthname (aref calendar-persian-month-name-array (1- m)))
(day (int-to-string (extract-calendar-day persian-date)))
(day (int-to-string (calendar-extract-day persian-date)))
(year (int-to-string y))
(month (int-to-string m))
dayname)
@ -175,7 +175,7 @@ Reads a year, month, and day."
"Persian calendar year (not 0): "
(lambda (x) (not (zerop x)))
(int-to-string
(extract-calendar-year
(calendar-extract-year
(calendar-persian-from-absolute
(calendar-absolute-from-gregorian
(calendar-current-date)))))))

238
lisp/calendar/cal-tex.el
View file

@ -97,7 +97,7 @@ At present, this only affects the daily filofax calendar."
:group 'calendar-tex)
(defcustom cal-tex-daily-string
'(let* ((year (extract-calendar-year date))
'(let* ((year (calendar-extract-year date))
(day (calendar-day-number date))
(days-remaining (- (calendar-day-number (list 12 31 year)) day)))
(format "%d/%d" day days-remaining))
@ -242,20 +242,20 @@ This definition is the heart of the calendar!")
(defun cal-tex-list-holidays (d1 d2)
"Generate a list of all holidays from absolute date D1 to D2."
(let* ((start (calendar-gregorian-from-absolute d1))
(displayed-month (extract-calendar-month start))
(displayed-year (extract-calendar-year start))
(displayed-month (calendar-extract-month start))
(displayed-year (calendar-extract-year start))
(end (calendar-gregorian-from-absolute d2))
(end-month (extract-calendar-month end))
(end-year (extract-calendar-year end))
(end-month (calendar-extract-month end))
(end-year (calendar-extract-year end))
(number-of-intervals
(1+ (/ (calendar-interval displayed-month displayed-year
end-month end-year)
3)))
holidays in-range a)
(increment-calendar-month displayed-month displayed-year 1)
(calendar-increment-month displayed-month displayed-year 1)
(dotimes (idummy number-of-intervals)
(setq holidays (append holidays (calendar-holiday-list)))
(increment-calendar-month displayed-month displayed-year 3))
(calendar-increment-month displayed-month displayed-year 3))
(dolist (hol holidays)
(and (car hol)
(setq a (calendar-absolute-from-gregorian (car hol)))
@ -317,7 +317,7 @@ Optional string ARGS are included as options for the article document class."
"Make a buffer with LaTeX commands for the year cursor is on.
Optional prefix argument ARG specifies number of years."
(interactive "p")
(cal-tex-year (extract-calendar-year (calendar-cursor-to-date t))
(cal-tex-year (calendar-extract-year (calendar-cursor-to-date t))
(or arg 1)))
;;;###cal-autoload
@ -325,7 +325,7 @@ Optional prefix argument ARG specifies number of years."
"Make a buffer with LaTeX commands for the year cursor is on.
Optional prefix argument ARG specifies number of years."
(interactive "p")
(cal-tex-year (extract-calendar-year (calendar-cursor-to-date t))
(cal-tex-year (calendar-extract-year (calendar-cursor-to-date t))
(or arg 1) t))
(defun cal-tex-year (year n &optional landscape)
@ -370,7 +370,7 @@ landscape mode with three rows of four months each."
Optional prefix argument ARG specifies number of years."
(interactive "p")
(let ((n (or arg 1))
(year (extract-calendar-year (calendar-cursor-to-date t))))
(year (calendar-extract-year (calendar-cursor-to-date t))))
(cal-tex-preamble "twoside")
(cal-tex-cmd "\\textwidth 3.25in")
(cal-tex-cmd "\\textheight 6.5in")
@ -427,8 +427,8 @@ month to a page. It shows holiday and diary entries if
(interactive "p")
(let* ((n (or arg 1))
(date (calendar-cursor-to-date t))
(month (extract-calendar-month date))
(year (extract-calendar-year date))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(end-month month)
(end-year year)
(cal-tex-which-days '(0 1 2 3 4 5 6))
@ -438,7 +438,7 @@ month to a page. It shows holiday and diary entries if
(calendar-last-day-of-month end-month end-year)
end-year)))
(diary-list (progn
(increment-calendar-month end-month end-year (1- n))
(calendar-increment-month end-month end-year (1- n))
(if cal-tex-diary (cal-tex-list-diary-entries d1 d2))))
(holidays (if cal-tex-holidays (cal-tex-list-holidays d1 d2)))
other-month other-year small-months-at-start)
@ -447,10 +447,10 @@ month to a page. It shows holiday and diary entries if
(dotimes (i n)
(setq other-month month
other-year year)
(increment-calendar-month other-month other-year -1)
(calendar-increment-month other-month other-year -1)
(insert (cal-tex-mini-calendar other-month other-year "lastmonth"
"\\cellwidth" "\\cellheight"))
(increment-calendar-month other-month other-year 2)
(calendar-increment-month other-month other-year 2)
(insert (cal-tex-mini-calendar other-month other-year "nextmonth"
"\\cellwidth" "\\cellheight"))
(cal-tex-insert-month-header 1 month year month year)
@ -478,7 +478,7 @@ month to a page. It shows holiday and diary entries if
(unless (= i (1- n))
(run-hooks 'cal-tex-month-hook)
(cal-tex-newpage)
(increment-calendar-month month year 1)
(calendar-increment-month month year 1)
(cal-tex-vspace "-2cm")
(cal-tex-insert-preamble
(cal-tex-number-weeks month year 1) t "12pt" t))))
@ -495,8 +495,8 @@ It shows holiday and diary entries if `cal-tex-holidays' and
(interactive "p")
(let* ((n (or arg 1))
(date (calendar-cursor-to-date t))
(month (extract-calendar-month date))
(year (extract-calendar-year date))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(end-month month)
(end-year year)
(d1 (calendar-absolute-from-gregorian (list month 1 year)))
@ -505,7 +505,7 @@ It shows holiday and diary entries if `cal-tex-holidays' and
(calendar-last-day-of-month end-month end-year)
end-year)))
(diary-list (progn
(increment-calendar-month end-month end-year (1- n))
(calendar-increment-month end-month end-year (1- n))
(if cal-tex-diary (cal-tex-list-diary-entries d1 d2))))
(holidays (if cal-tex-holidays (cal-tex-list-holidays d1 d2)))
other-month other-year)
@ -528,7 +528,7 @@ It shows holiday and diary entries if `cal-tex-holidays' and
7)) ; last day of month was Saturday
(cal-tex-hfill)
(cal-tex-nl))
(increment-calendar-month month year 1))
(calendar-increment-month month year 1))
(cal-tex-insert-blank-days-at-end end-month end-year cal-tex-day-prefix))
(cal-tex-end-document)
(run-hooks 'cal-tex-hook))
@ -650,7 +650,7 @@ Compute the number of weeks in the calendar starting with MONTH and YEAR,
and lasting N months, including only the days in WHICH-DAYS. As it stands,
this is only an upper bound."
(let ((d (list month 1 year)))
(increment-calendar-month month year (1- n))
(calendar-increment-month month year (1- n))
(/ (- (calendar-dayname-on-or-before
calendar-week-start-day
(+ 7 (calendar-absolute-from-gregorian
@ -685,8 +685,8 @@ entries are not shown). The calendar shows the hours 8-12am, 1-5pm."
calendar-week-start-day
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))
(month (extract-calendar-month date))
(year (extract-calendar-year date))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@ -714,8 +714,8 @@ entries are not shown). The calendar shows the hours 8-12am, 1-5pm."
(cal-tex-week-hours date holidays "3.1")
(setq date (cal-tex-incr-date date)))
(cal-tex-e-parbox)
(setq month (extract-calendar-month date)
year (extract-calendar-year date))
(setq month (calendar-extract-month date)
year (calendar-extract-year date))
(unless (= i (1- n))
(run-hooks 'cal-tex-week-hook)
(cal-tex-newpage)))
@ -738,8 +738,8 @@ entries are not shown). The calendar shows the hours 8-12am, 1-5pm"
calendar-week-start-day
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))
(month (extract-calendar-month date))
(year (extract-calendar-year date))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(d date)
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
@ -770,16 +770,16 @@ entries are not shown). The calendar shows the hours 8-12am, 1-5pm"
(cal-tex-e-parbox)
(cal-tex-nl)
(insert (cal-tex-mini-calendar
(extract-calendar-month (cal-tex-previous-month date))
(extract-calendar-year (cal-tex-previous-month date))
(calendar-extract-month (cal-tex-previous-month date))
(calendar-extract-year (cal-tex-previous-month date))
"lastmonth" "1.1in" "1in"))
(insert (cal-tex-mini-calendar
(extract-calendar-month date)
(extract-calendar-year date)
(calendar-extract-month date)
(calendar-extract-year date)
"thismonth" "1.1in" "1in"))
(insert (cal-tex-mini-calendar
(extract-calendar-month (cal-tex-next-month date))
(extract-calendar-year (cal-tex-next-month date))
(calendar-extract-month (cal-tex-next-month date))
(calendar-extract-year (cal-tex-next-month date))
"nextmonth" "1.1in" "1in"))
(insert "\\hbox to \\textwidth{")
(cal-tex-hfill)
@ -796,8 +796,8 @@ entries are not shown). The calendar shows the hours 8-12am, 1-5pm"
(cal-tex-week-hours date holidays "5")
(setq date (cal-tex-incr-date date)))
(cal-tex-e-parbox)
(setq month (extract-calendar-month date)
year (extract-calendar-year date))
(setq month (calendar-extract-month date)
year (calendar-extract-year date))
(unless (= i (1- n))
(run-hooks 'cal-tex-week-hook)
(cal-tex-newpage)))
@ -820,9 +820,9 @@ It does not show hours of the day."
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))
(month (extract-calendar-month date))
(year (extract-calendar-year date))
(day (extract-calendar-day date))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@ -847,8 +847,8 @@ It does not show hours of the day."
(let ((d (calendar-iso-from-absolute
(calendar-absolute-from-gregorian date))))
(format "Week %d of %d"
(extract-calendar-month d)
(extract-calendar-year d))))
(calendar-extract-month d)
(calendar-extract-year d))))
(cal-tex-nl ".5cm")
(cal-tex-e-center)
(cal-tex-b-parbox "l" "\\textwidth")
@ -881,13 +881,13 @@ It does not show hours of the day."
(cal-tex-e-parbox)
(cal-tex-nl)
(setq date (cal-tex-incr-date date)
month (extract-calendar-month date)
day (extract-calendar-day date))
month (calendar-extract-month date)
day (calendar-extract-day date))
(cal-tex-e-parbox)
(cal-tex-e-parbox "2cm")
(cal-tex-nl)
(setq month (extract-calendar-month date)
year (extract-calendar-year date)))
(setq month (calendar-extract-month date)
year (calendar-extract-year date)))
(cal-tex-e-parbox)
(unless (= i (1- n))
(run-hooks 'cal-tex-week-hook)
@ -901,9 +901,9 @@ It does not show hours of the day."
"Insert hourly entries for DATE with HOLIDAYS, with line height HEIGHT.
Uses the 24-hour clock if `cal-tex-24' is non-nil. Note that the hours
shown are hard-coded to 8-12, 13-17."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(let ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
morning afternoon s)
(cal-tex-comment "begin cal-tex-week-hours")
(cal-tex-cmd "\\ \\\\[-.2cm]")
@ -983,14 +983,14 @@ the hours 8-12am, 1-5pm."
"Make one box for DATE, different if WEEKEND.
Uses the 24-hour clock if `cal-tex-24' is non-nil. Note that the hours
shown are hard-coded to 8-12, 13-17."
(let* ((day (extract-calendar-day date))
(month (extract-calendar-month date))
(year (extract-calendar-year date))
(let* ((day (calendar-extract-day date))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(dayname (cal-tex-LaTeXify-string (calendar-day-name date)))
(date1 (cal-tex-incr-date date))
(day1 (extract-calendar-day date1))
(month1 (extract-calendar-month date1))
(year1 (extract-calendar-year date1))
(day1 (calendar-extract-day date1))
(month1 (calendar-extract-month date1))
(year1 (calendar-extract-year date1))
(dayname1 (cal-tex-LaTeXify-string (calendar-day-name date1))))
(cal-tex-b-framebox "8cm" "l")
(cal-tex-b-parbox "b" "7.5cm")
@ -1032,9 +1032,9 @@ The calendar shows holiday and diary entries if
calendar-week-start-day
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))
(month (extract-calendar-month date))
(year (extract-calendar-year date))
(day (extract-calendar-day date))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@ -1080,29 +1080,29 @@ The calendar shows holiday and diary entries if
(insert "\\lefthead"))
(cal-tex-arg
(let ((d (cal-tex-incr-date date 6)))
(if (= (extract-calendar-month date)
(extract-calendar-month d))
(if (= (calendar-extract-month date)
(calendar-extract-month d))
(format "%s %s"
(cal-tex-month-name (extract-calendar-month date))
(extract-calendar-year date))
(if (= (extract-calendar-year date)
(extract-calendar-year d))
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date))
(if (= (calendar-extract-year date)
(calendar-extract-year d))
(format "%s---%s %s"
(cal-tex-month-name (extract-calendar-month date))
(cal-tex-month-name (extract-calendar-month d))
(extract-calendar-year date))
(cal-tex-month-name (calendar-extract-month date))
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year date))
(format "%s %s---%s %s"
(cal-tex-month-name (extract-calendar-month date))
(extract-calendar-year date)
(cal-tex-month-name (extract-calendar-month d))
(extract-calendar-year d))))))
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date)
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year d))))))
(insert "%\n")
(dotimes (jdummy 7)
(if (zerop (mod i 2))
(insert "\\rightday")
(insert "\\leftday"))
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (int-to-string (extract-calendar-day date)))
(cal-tex-arg (int-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
@ -1127,9 +1127,9 @@ if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil."
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))
(month (extract-calendar-month date))
(year (extract-calendar-year date))
(day (extract-calendar-day date))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@ -1182,27 +1182,27 @@ if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil."
(insert "\\lefthead")
(cal-tex-arg
(let ((d (cal-tex-incr-date date 2)))
(if (= (extract-calendar-month date)
(extract-calendar-month d))
(if (= (calendar-extract-month date)
(calendar-extract-month d))
(format "%s %s"
(cal-tex-month-name (extract-calendar-month date))
(extract-calendar-year date))
(if (= (extract-calendar-year date)
(extract-calendar-year d))
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date))
(if (= (calendar-extract-year date)
(calendar-extract-year d))
(format "%s---%s %s"
(cal-tex-month-name (extract-calendar-month date))
(cal-tex-month-name (extract-calendar-month d))
(extract-calendar-year date))
(cal-tex-month-name (calendar-extract-month date))
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year date))
(format "%s %s---%s %s"
(cal-tex-month-name (extract-calendar-month date))
(extract-calendar-year date)
(cal-tex-month-name (extract-calendar-month d))
(extract-calendar-year d))))))
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date)
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year d))))))
(insert "%\n")
(dotimes (jdummy 3)
(insert "\\leftday")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (int-to-string (extract-calendar-day date)))
(cal-tex-arg (int-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
@ -1213,27 +1213,27 @@ if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil."
(insert "\\righthead")
(cal-tex-arg
(let ((d (cal-tex-incr-date date 3)))
(if (= (extract-calendar-month date)
(extract-calendar-month d))
(if (= (calendar-extract-month date)
(calendar-extract-month d))
(format "%s %s"
(cal-tex-month-name (extract-calendar-month date))
(extract-calendar-year date))
(if (= (extract-calendar-year date)
(extract-calendar-year d))
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date))
(if (= (calendar-extract-year date)
(calendar-extract-year d))
(format "%s---%s %s"
(cal-tex-month-name (extract-calendar-month date))
(cal-tex-month-name (extract-calendar-month d))
(extract-calendar-year date))
(cal-tex-month-name (calendar-extract-month date))
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year date))
(format "%s %s---%s %s"
(cal-tex-month-name (extract-calendar-month date))
(extract-calendar-year date)
(cal-tex-month-name (extract-calendar-month d))
(extract-calendar-year d))))))
(cal-tex-month-name (calendar-extract-month date))
(calendar-extract-year date)
(cal-tex-month-name (calendar-extract-month d))
(calendar-extract-year d))))))
(insert "%\n")
(dotimes (jdummy 2)
(insert "\\rightday")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (int-to-string (extract-calendar-day date)))
(cal-tex-arg (int-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
@ -1242,7 +1242,7 @@ if `cal-tex-holidays' and `cal-tex-diary', respectively, are non-nil."
(dotimes (jdummy 2)
(insert "\\weekend")
(cal-tex-arg (cal-tex-LaTeXify-string (calendar-day-name date)))
(cal-tex-arg (int-to-string (extract-calendar-day date)))
(cal-tex-arg (int-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
(cal-tex-arg (eval cal-tex-daily-string))
@ -1268,9 +1268,9 @@ are non-nil. Pages are ruled if `cal-tex-rules' is non-nil."
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t)))))
(month (extract-calendar-month date))
(year (extract-calendar-year date))
(day (extract-calendar-day date))
(month (calendar-extract-month date))
(year (calendar-extract-year date))
(day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@ -1397,14 +1397,14 @@ the 24-hour clock if `cal-tex-24' is non-nil."
Uses the 24-hour clock if `cal-tex-24' is non-nil. Produces
hourly sections for the period specified by `cal-tex-daily-start'
and `cal-tex-daily-end'."
(let ((month-name (cal-tex-month-name (extract-calendar-month date)))
(let ((month-name (cal-tex-month-name (calendar-extract-month date)))
(i (1- cal-tex-daily-start))
hour)
(cal-tex-banner "cal-tex-daily-page")
(cal-tex-b-makebox "4cm" "l")
(cal-tex-b-parbox "b" "3.8cm")
(cal-tex-rule "0mm" "0mm" "2cm")
(cal-tex-Huge (number-to-string (extract-calendar-day date)))
(cal-tex-Huge (number-to-string (calendar-extract-day date)))
(cal-tex-nl ".5cm")
(cal-tex-bf month-name )
(cal-tex-e-parbox)
@ -1438,16 +1438,16 @@ and `cal-tex-daily-end'."
(cal-tex-nl ".2cm"))
(cal-tex-hfill)
(insert (cal-tex-mini-calendar
(extract-calendar-month (cal-tex-previous-month date))
(extract-calendar-year (cal-tex-previous-month date))
(calendar-extract-month (cal-tex-previous-month date))
(calendar-extract-year (cal-tex-previous-month date))
"lastmonth" "1.1in" "1in"))
(insert (cal-tex-mini-calendar
(extract-calendar-month date)
(extract-calendar-year date)
(calendar-extract-month date)
(calendar-extract-year date)
"thismonth" "1.1in" "1in"))
(insert (cal-tex-mini-calendar
(extract-calendar-month (cal-tex-next-month date))
(extract-calendar-year (cal-tex-next-month date))
(calendar-extract-month (cal-tex-next-month date))
(calendar-extract-year (cal-tex-next-month date))
"nextmonth" "1.1in" "1in"))
(insert "\\hbox to \\textwidth{")
(cal-tex-hfill)
@ -1544,16 +1544,16 @@ FINAL-SEPARATOR is non-nil."
(defun cal-tex-previous-month (date)
"Return the date of the first day in the month previous to DATE."
(let ((month (extract-calendar-month date))
(year (extract-calendar-year date)))
(increment-calendar-month month year -1)
(let ((month (calendar-extract-month date))
(year (calendar-extract-year date)))
(calendar-increment-month month year -1)
(list month 1 year)))
(defun cal-tex-next-month (date)
"Return the date of the first day in the month following DATE."
(let ((month (extract-calendar-month date))
(year (extract-calendar-year date)))
(increment-calendar-month month year 1)
(let ((month (calendar-extract-month date))
(year (calendar-extract-year date)))
(calendar-increment-month month year 1)
(list month 1 year)))
;;;

8
lisp/calendar/cal-x.el
View file

@ -100,10 +100,10 @@ Runs `calendar-after-frame-setup-hook', selects frame, iconifies if needed."
(get-file-buffer diary-file)
;; If there are no diary entries, there won't be a fancy-diary
;; to dedicate, so make a basic one.
(or (get-buffer fancy-diary-buffer)
(calendar-in-read-only-buffer fancy-diary-buffer
(or (get-buffer diary-fancy-buffer)
(calendar-in-read-only-buffer diary-fancy-buffer
(calendar-set-mode-line "Diary Entries")))
fancy-diary-buffer))
diary-fancy-buffer))
t))
;;;###cal-autoload
@ -124,7 +124,7 @@ If PROMPT is non-nil, prompt for the month and year to use."
(if (frame-live-p calendar-frame) (delete-frame calendar-frame))
(unless (eq config 'calendar-only)
(if (frame-live-p diary-frame) (delete-frame diary-frame)))
(let ((view-diary-entries-initially (eq config 'one-frame))
(let ((calendar-view-diary-initially-flag (eq config 'one-frame))
;; For calendar-dedicate-diary in two-frames case.
(pop-up-windows nil))
(save-window-excursion

140
lisp/calendar/diary-lib.el
View file

@ -371,7 +371,7 @@ Only used if `diary-header-line-flag' is non-nil."
;;;###cal-autoload
(defun diary-live-p ()
"Return non-nil if the diary is being displayed."
(or (get-buffer fancy-diary-buffer)
(or (get-buffer diary-fancy-buffer)
(and diary-file
(find-buffer-visiting (substitute-in-file-name diary-file)))))
@ -390,7 +390,7 @@ just visiting the `diary-file'), and SYMBOL's value is to be changed."
(defcustom diary-number-of-entries 1
"Specifies how many days of diary entries are to be displayed initially.
This variable affects the diary display when the command \\[diary] is used,
or if the value of the variable `view-diary-entries-initially' is non-nil.
or if the value of the variable `calendar-view-diary-initially-flag' is non-nil.
For example, if the default value 1 is used, then only the current day's diary
entries will be displayed. If the value 2 is used, then both the current
day's and the next day's entries will be displayed.
@ -587,9 +587,9 @@ non-nil, don't change the buffer, only return a list of entries.
Optional array MONTHS replaces `calendar-month-name-array', and
means months cannot be abbreviated. Optional string SYMBOL marks diary
entries of the desired type. Returns non-nil if any entries were found."
(let* ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(let* ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
(dayname (format "%s\\|%s\\.?" (calendar-day-name date)
(calendar-day-name date 'abbrev)))
(calendar-month-name-array (or months calendar-month-name-array))
@ -818,7 +818,7 @@ changing the variable `diary-include-string'."
"Common subroutine of `diary-simple-display' and `diary-fancy-display'.
Handles the case where there are no diary entries.
Returns a cons (NOENTRIES . HOLIDAY-STRING)."
(let* ((holiday-list (if holidays-in-diary-buffer
(let* ((holiday-list (if diary-show-holidays-flag
(calendar-check-holidays original-date)))
(hol-string (format "%s%s%s"
date-string
@ -857,7 +857,7 @@ Returns a cons (NOENTRIES . HOLIDAY-STRING)."
(empty (diary-display-no-entries)))
;; This may be too wide, but when simple diary is used there is
;; nowhere else for the holidays to go. Also, it is documented in
;; holidays-in-diary-buffer that the holidays go in the mode-line.
;; diary-show-holidays-flag that the holidays go in the mode-line.
;; FIXME however if there are no diary entries a separate buffer
;; is displayed - this is inconsistent.
(with-current-buffer dbuff
@ -910,7 +910,7 @@ To use this function, add it to `diary-display-hook'."
(diary-unhide-everything))
(unless (car (diary-display-no-entries)) ; no entries
;; Prepare the fancy diary buffer.
(calendar-in-read-only-buffer fancy-diary-buffer
(calendar-in-read-only-buffer diary-fancy-buffer
(calendar-set-mode-line "Diary Entries")
(let ((holiday-list-last-month 1)
(holiday-list-last-year 1)
@ -919,7 +919,7 @@ To use this function, add it to `diary-display-hook'."
(dolist (entry diary-entries-list)
(unless (calendar-date-equal date (car entry))
(setq date (car entry))
(and holidays-in-diary-buffer
(and diary-show-holidays-flag
(calendar-date-compare
(list (list holiday-list-last-month
(calendar-last-day-of-month
@ -929,18 +929,18 @@ To use this function, add it to `diary-display-hook'."
(list date))
;; We need to get the holidays for the next 3 months.
(setq holiday-list-last-month
(extract-calendar-month date)
(calendar-extract-month date)
holiday-list-last-year
(extract-calendar-year date))
(calendar-extract-year date))
(progn
(increment-calendar-month
(calendar-increment-month
holiday-list-last-month holiday-list-last-year 1)
t)
(setq holiday-list
(let ((displayed-month holiday-list-last-month)
(displayed-year holiday-list-last-year))
(calendar-holiday-list)))
(increment-calendar-month
(calendar-increment-month
holiday-list-last-month holiday-list-last-year 1))
(let ((longest 0)
date-holiday-list cc)
@ -999,7 +999,7 @@ If the fancy diary display is being used, just print the buffer.
The hooks given by the variable `diary-print-entries-hook' are called to do
the actual printing."
(interactive)
(let ((diary-buffer (get-buffer fancy-diary-buffer))
(let ((diary-buffer (get-buffer diary-fancy-buffer))
temp-buffer heading start end)
(if diary-buffer
(with-current-buffer diary-buffer
@ -1085,8 +1085,8 @@ should ensure that all relevant variables are set.
(concat "Diary entries generated "
(calendar-date-string (calendar-current-date))))
(insert
(if (get-buffer fancy-diary-buffer)
(with-current-buffer fancy-diary-buffer (buffer-string))
(if (get-buffer diary-fancy-buffer)
(with-current-buffer diary-fancy-buffer (buffer-string))
"No entries found"))
(call-interactively (get mail-user-agent 'sendfunc))))
@ -1173,7 +1173,7 @@ function that converts absolute dates to dates of the appropriate type. "
(if (and (= (length y-str) 2)
diary-abbreviated-year-flag)
(let* ((current-y
(extract-calendar-year
(calendar-extract-year
(if absfunc
(funcall
absfunc
@ -1232,15 +1232,15 @@ diary entries."
;; ii) called via calendar-redraw (since calendar has already been
;; erased).
;; Use of REDRAW handles both of these cases.
(when (and redraw mark-diary-entries-in-calendar)
(setq mark-diary-entries-in-calendar nil)
(redraw-calendar))
(when (and redraw calendar-mark-diary-entries-flag)
(setq calendar-mark-diary-entries-flag nil)
(calendar-redraw))
(let ((diary-marking-entries-flag t)
file-glob-attrs)
(with-current-buffer (find-file-noselect (diary-check-diary-file) t)
(save-excursion
(when (eq major-mode default-major-mode) (diary-mode))
(setq mark-diary-entries-in-calendar t)
(setq calendar-mark-diary-entries-flag t)
(message "Marking diary entries...")
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(with-syntax-table diary-syntax-table
@ -1272,7 +1272,7 @@ diary entries."
(result entry)
(t nil))))
(defvar displayed-year) ; bound in generate-calendar
(defvar displayed-year) ; bound in calendar-generate
(defvar displayed-month)
(defun diary-mark-sexp-entries ()
@ -1289,10 +1289,10 @@ is marked. See the documentation for the function `diary-list-sexp-entries'."
(with-current-buffer calendar-buffer
(setq m displayed-month
y displayed-year))
(increment-calendar-month m y -1)
(calendar-increment-month m y -1)
(setq first-date (calendar-absolute-from-gregorian (list m 1 y))
date (1- first-date))
(increment-calendar-month m y 2)
(calendar-increment-month m y 2)
(setq last-date
(calendar-absolute-from-gregorian
(list m (calendar-last-day-of-month m y) y)))
@ -1320,7 +1320,7 @@ is marked. See the documentation for the function `diary-list-sexp-entries'."
(when (setq mark (diary-sexp-entry
sexp entry
(calendar-gregorian-from-absolute date)))
(mark-visible-calendar-date
(calendar-mark-visible-date
(calendar-gregorian-from-absolute date)
(or (cadr (diary-pull-attrs entry file-glob-attrs))
(if (consp mark) (car mark)))))))))
@ -1365,7 +1365,7 @@ changing the variable `diary-include-string'."
(defun calendar-mark-days-named (dayname &optional color)
"Mark all dates in the calendar window that are day DAYNAME of the week.
0 means all Sundays, 1 means all Mondays, and so on.
Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
(with-current-buffer calendar-buffer
(let ((prev-month displayed-month)
(prev-year displayed-year)
@ -1373,14 +1373,14 @@ Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
(succ-year displayed-year)
(last-day)
(day))
(increment-calendar-month succ-month succ-year 1)
(increment-calendar-month prev-month prev-year -1)
(calendar-increment-month succ-month succ-year 1)
(calendar-increment-month prev-month prev-year -1)
(setq day (calendar-absolute-from-gregorian
(calendar-nth-named-day 1 dayname prev-month prev-year))
last-day (calendar-absolute-from-gregorian
(calendar-nth-named-day -1 dayname succ-month succ-year)))
(while (<= day last-day)
(mark-visible-calendar-date (calendar-gregorian-from-absolute day)
(calendar-mark-visible-date (calendar-gregorian-from-absolute day)
color)
(setq day (+ day 7))))))
@ -1390,15 +1390,15 @@ Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
(defun calendar-mark-month (month year p-month p-day p-year &optional color)
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P-DAY/P-YEAR.
A value of 0 in any position of the pattern is a wildcard.
Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
(if (or (and (= month p-month)
(or (zerop p-year) (= year p-year)))
(and (zerop p-month)
(or (zerop p-year) (= year p-year))))
(if (zerop p-day)
(dotimes (i (calendar-last-day-of-month month year))
(mark-visible-calendar-date (list month (1+ i) year) color))
(mark-visible-calendar-date (list month p-day year) color))))
(calendar-mark-visible-date (list month (1+ i) year) color))
(calendar-mark-visible-date (list month p-day year) color))))
(define-obsolete-function-alias 'mark-calendar-month
'calendar-mark-month "23.1")
@ -1406,14 +1406,14 @@ Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
(defun calendar-mark-date-pattern (month day year &optional color)
"Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard. Optional argument COLOR is
passed to `mark-visible-calendar-date' as MARK."
passed to `calendar-mark-visible-date' as MARK."
(with-current-buffer calendar-buffer
(let ((m displayed-month)
(y displayed-year))
(increment-calendar-month m y -1)
(calendar-increment-month m y -1)
(dotimes (idummy 3)
(calendar-mark-month m y month day year color)
(increment-calendar-month m y 1)))))
(calendar-increment-month m y 1)))))
(define-obsolete-function-alias 'mark-calendar-date-pattern
'calendar-mark-date-pattern "23.1")
@ -1422,17 +1422,17 @@ passed to `mark-visible-calendar-date' as MARK."
(defun calendar-mark-complex (month day year fromabs &optional color)
"Mark dates in the calendar conforming to MONTH DAY YEAR of some system.
The function FROMABS converts absolute dates to the appropriate date system.
Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
;; Not one of the simple cases--check all visible dates for match.
;; Actually, the following code takes care of ALL of the cases, but
;; it's much too slow to be used for the simple (common) cases.
(let* ((m displayed-month)
(y displayed-year)
(first-date (progn
(increment-calendar-month m y -1)
(calendar-increment-month m y -1)
(calendar-absolute-from-gregorian (list m 1 y))))
(last-date (progn
(increment-calendar-month m y 2)
(calendar-increment-month m y 2)
(calendar-absolute-from-gregorian
(list m (calendar-last-day-of-month m y) y))))
(date (1- first-date))
@ -1440,12 +1440,12 @@ Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
(while (<= (setq date (1+ date)) last-date)
(setq local-date (funcall fromabs date))
(and (or (zerop month)
(= month (extract-calendar-month local-date)))
(= month (calendar-extract-month local-date)))
(or (zerop day)
(= day (extract-calendar-day local-date)))
(= day (calendar-extract-day local-date)))
(or (zerop year)
(= year (extract-calendar-year local-date)))
(mark-visible-calendar-date
(= year (calendar-extract-year local-date)))
(calendar-mark-visible-date
(calendar-gregorian-from-absolute date) color)))))
;; Bahai, Islamic.
@ -1453,7 +1453,7 @@ Optional argument COLOR is passed to `mark-visible-calendar-date' as MARK."
"Mark dates in the calendar conforming to MONTH DAY YEAR of some system.
The function FROMABS converts absolute dates to the appropriate date system.
The function TOABDS carries out the inverse operation. Optional argument
COLOR is passed to `mark-visible-calendar-date' as MARK."
COLOR is passed to `calendar-mark-visible-date' as MARK."
(save-excursion
(set-buffer calendar-buffer)
(if (and (not (zerop month)) (not (zerop day)))
@ -1462,21 +1462,21 @@ COLOR is passed to `mark-visible-calendar-date' as MARK."
(let ((date (calendar-gregorian-from-absolute
(funcall toabs (list month day year)))))
(if (calendar-date-is-visible-p date)
(mark-visible-calendar-date date color)))
(calendar-mark-visible-date date color)))
;; Month and day in any year--this taken from the holiday stuff.
(let* ((i-date (funcall fromabs
(calendar-absolute-from-gregorian
(list displayed-month 15 displayed-year))))
(m (extract-calendar-month i-date))
(y (extract-calendar-year i-date))
(m (calendar-extract-month i-date))
(y (calendar-extract-year i-date))
date)
(unless (< m 1) ; calendar doesn't apply
(increment-calendar-month m y (- 10 month))
(calendar-increment-month m y (- 10 month))
(and (> m 7) ; date might be visible
(calendar-date-is-visible-p
(setq date (calendar-gregorian-from-absolute
(funcall toabs (list month day y)))))
(mark-visible-calendar-date date color)))))
(calendar-mark-visible-date date color)))))
(calendar-mark-complex month day year
'calendar-bahai-from-absolute color))))
@ -1545,7 +1545,7 @@ the month if it is a weekday and the Friday before if the 21st is
on a weekend:
&%%(let ((dayname (calendar-day-of-week date))
(day (extract-calendar-day date)))
(day (calendar-extract-day date)))
(or
(and (= day 21) (memq dayname '(1 2 3 4 5)))
(and (memq day '(19 20)) (= dayname 5)))
@ -1713,12 +1713,12 @@ order of the input parameters changes according to `calendar-date-style'
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
(let* ((ddate (diary-make-date month day year))
(dd (extract-calendar-day ddate))
(mm (extract-calendar-month ddate))
(yy (extract-calendar-year ddate))
(m (extract-calendar-month date))
(y (extract-calendar-year date))
(d (extract-calendar-day date)))
(dd (calendar-extract-day ddate))
(mm (calendar-extract-month ddate))
(yy (calendar-extract-year ddate))
(m (calendar-extract-month date))
(y (calendar-extract-year date))
(d (calendar-extract-day date)))
(and
(or (and (listp dd) (memq d dd))
(equal d dd)
@ -1763,9 +1763,9 @@ highlighting the day in the calendar."
;; first Monday after December 30. For large values of |n| the problem is
;; more grotesque.
(and (= dayname (calendar-day-of-week date))
(let* ((m (extract-calendar-month date))
(d (extract-calendar-day date))
(y (extract-calendar-year date))
(let* ((m (calendar-extract-month date))
(d (calendar-extract-day date))
(y (calendar-extract-year date))
;; Last (n>0) or first (n<0) possible base date for entry.
(limit
(calendar-nth-named-absday (- n) dayname m y d))
@ -1774,13 +1774,13 @@ highlighting the day in the calendar."
(last (calendar-gregorian-from-absolute last-abs))
(first (calendar-gregorian-from-absolute first-abs))
;; m1, d1 is first possible base date.
(m1 (extract-calendar-month first))
(d1 (extract-calendar-day first))
(y1 (extract-calendar-year first))
(m1 (calendar-extract-month first))
(d1 (calendar-extract-day first))
(y1 (calendar-extract-year first))
;; m2, d2 is last possible base date.
(m2 (extract-calendar-month last))
(d2 (extract-calendar-day last))
(y2 (extract-calendar-year last)))
(m2 (calendar-extract-month last))
(d2 (calendar-extract-day last))
(y2 (calendar-extract-year last)))
(if (or (and (= m1 m2) ; only possible base dates in one month
(or (eq month t)
(if (listp month)
@ -1837,10 +1837,10 @@ February 29 is considered to be March 1 in non-leap years.
An optional parameter MARK specifies a face or single-character
string to use when highlighting the day in the calendar."
(let* ((ddate (diary-make-date month day year))
(dd (extract-calendar-day ddate))
(mm (extract-calendar-month ddate))
(yy (extract-calendar-year ddate))
(y (extract-calendar-year date))
(dd (calendar-extract-day ddate))
(mm (calendar-extract-month ddate))
(yy (calendar-extract-year ddate))
(y (calendar-extract-year date))
(diff (if yy (- y yy) 100)))
(and (= mm 2) (= dd 29) (not (calendar-leap-year-p y))
(setq mm 3
@ -2096,9 +2096,9 @@ Prefix argument ARG makes the entry nonmarking."
(defun diary-redraw-calendar ()
"If `calendar-buffer' is live and diary entries are marked, redraw it."
(and mark-diary-entries-in-calendar
(and calendar-mark-diary-entries-flag
(save-excursion
(redraw-calendar)))
(calendar-redraw)))
;; Return value suitable for `write-contents-functions'.
nil)

75
lisp/calendar/holidays.el
View file

@ -51,7 +51,7 @@ The holidays are those in the list `calendar-holidays'."
(setq res (append h res))))
'calendar-date-compare)))
(defvar displayed-month) ; from generate-calendar
(defvar displayed-month) ; from calendar-generate
(defvar displayed-year)
;;;###cal-autoload
@ -69,8 +69,8 @@ Returns non-nil if any holidays are found."
(if (not holiday-list)
(message "Looking up holidays...none found")
(calendar-in-read-only-buffer holiday-buffer
(increment-calendar-month m1 y1 -1)
(increment-calendar-month m2 y2 1)
(calendar-increment-month m1 y1 -1)
(calendar-increment-month m2 y2 1)
(calendar-set-mode-line
(if (= y1 y2)
(format "Notable Dates from %s to %s, %d%%-"
@ -98,8 +98,8 @@ This function is suitable for execution in a .emacs file."
(let* ((completion-ignore-case t)
(date (if arg (calendar-read-date t)
(calendar-current-date)))
(displayed-month (extract-calendar-month date))
(displayed-year (extract-calendar-year date)))
(displayed-month (calendar-extract-month date))
(displayed-year (calendar-extract-year date)))
(calendar-list-holidays))))
;; rms: "Emacs commands to display a list of something generally start
@ -112,13 +112,13 @@ Y2 defaults to Y1. The optional list of holidays L defaults to
displayed, use a different list. For example,
(list-holidays 2006 2006
(append general-holidays local-holidays other-holidays))
(append holiday-general-holidays holiday-local-holidays))
will display holidays for the year 2006 defined in the 3
will display holidays for the year 2006 defined in the two
mentioned lists, and nothing else.
When called interactively, this command offers a choice of
holidays, based on the variables `solar-holidays' etc. See the
holidays, based on the variables `holiday-solar-holidays' etc. See the
documentation of `calendar-holidays' for a list of the variables
that control the choices, as well as a description of the format
of a holiday list.
@ -128,7 +128,7 @@ The optional LABEL is used to label the buffer created."
(let* ((start-year (calendar-read
"Starting year of holidays (>0): "
(lambda (x) (> x 0))
(int-to-string (extract-calendar-year
(int-to-string (calendar-extract-year
(calendar-current-date)))))
(end-year (calendar-read
(format "Ending year (inclusive) of holidays (>=%s): "
@ -141,15 +141,24 @@ The optional LABEL is used to label the buffer created."
(cons "All" calendar-holidays)
(cons "Equinoxes/Solstices"
(list (list 'solar-equinoxes-solstices)))
(if general-holidays (cons "General" general-holidays))
(if local-holidays (cons "Local" local-holidays))
(if other-holidays (cons "Other" other-holidays))
(if christian-holidays (cons "Christian" christian-holidays))
(if hebrew-holidays (cons "Hebrew" hebrew-holidays))
(if islamic-holidays (cons "Islamic" islamic-holidays))
(if bahai-holidays (cons "Baha'i" bahai-holidays))
(if oriental-holidays (cons "Oriental" oriental-holidays))
(if solar-holidays (cons "Solar" solar-holidays))
(if holiday-general-holidays
(cons "General" holiday-general-holidays))
(if holiday-local-holidays
(cons "Local" holiday-local-holidays))
(if holiday-other-holidays
(cons "Other" holiday-other-holidays))
(if holiday-christian-holidays
(cons "Christian" holiday-christian-holidays))
(if holiday-hebrew-holidays
(cons "Hebrew" holiday-hebrew-holidays))
(if holiday-islamic-holidays
(cons "Islamic" holiday-islamic-holidays))
(if holiday-bahai-holidays
(cons "Baha'i" holiday-bahai-holidays))
(if holiday-oriental-holidays
(cons "Oriental" holiday-oriental-holidays))
(if holiday-solar-holidays
(cons "Solar" holiday-solar-holidays))
(cons "Ask" nil)))
(choice (capitalize
(completing-read "List (TAB for choices): " lists nil t)))
@ -173,7 +182,7 @@ The optional LABEL is used to label the buffer created."
holiday-list)
(while (<= s e)
(setq holiday-list (append holiday-list (calendar-holiday-list)))
(increment-calendar-month displayed-month displayed-year 3)
(calendar-increment-month displayed-month displayed-year 3)
(setq s (calendar-absolute-from-gregorian
(list displayed-month 1 displayed-year))))
(save-excursion
@ -197,8 +206,8 @@ The optional LABEL is used to label the buffer created."
"Check the list of holidays for any that occur on DATE.
The value returned is a list of strings of relevant holiday descriptions.
The holidays are those in the list `calendar-holidays'."
(let ((displayed-month (extract-calendar-month date))
(displayed-year (extract-calendar-year date))
(let ((displayed-month (calendar-extract-month date))
(displayed-year (calendar-extract-year date))
holiday-list)
(dolist (h (calendar-holiday-list) holiday-list)
(if (calendar-date-equal date (car h))
@ -230,10 +239,10 @@ The holidays are those in the list `calendar-holidays'."
(defun calendar-mark-holidays ()
"Mark notable days in the calendar window."
(interactive)
(setq mark-holidays-in-calendar t)
(setq calendar-mark-holidays-flag t)
(message "Marking holidays...")
(dolist (holiday (calendar-holiday-list))
(mark-visible-calendar-date (car holiday) calendar-holiday-marker))
(calendar-mark-visible-date (car holiday) calendar-holiday-marker))
(message "Marking holidays...done"))
(define-obsolete-function-alias
@ -264,7 +273,7 @@ STRING)). Returns nil if it is not visible in the current calendar window."
;; November is visible; etc.
(let ((m displayed-month)
(y displayed-year))
(increment-calendar-month m y (- 11 month))
(calendar-increment-month m y (- 11 month))
(if (> m 9) ; is november visible?
(list (list (list month day y) string)))))
@ -286,7 +295,7 @@ Returns nil if it is not visible in the current calendar window."
;; function:
;; (let ((m displayed-month)
;; (y displayed-year))
;; (increment-calendar-month m y (- 11 month))
;; (calendar-increment-month m y (- 11 month))
;; (if (> m 9); month in year y is visible
;; (list (list (calendar-nth-named-day n dayname month y day) string)))))
(let* ((m1 displayed-month)
@ -294,18 +303,18 @@ Returns nil if it is not visible in the current calendar window."
(m2 displayed-month)
(y2 displayed-year)
(d1 (progn ; first possible base date for holiday
(increment-calendar-month m1 y1 -1)
(calendar-increment-month m1 y1 -1)
(+ (calendar-nth-named-absday 1 dayname m1 y1)
(* -7 n)
(if (> n 0) 1 -7))))
(d2 ; last possible base date for holiday
(progn
(increment-calendar-month m2 y2 1)
(calendar-increment-month m2 y2 1)
(+ (calendar-nth-named-absday -1 dayname m2 y2)
(* -7 n)
(if (> n 0) 7 -1))))
(y1 (extract-calendar-year (calendar-gregorian-from-absolute d1)))
(y2 (extract-calendar-year (calendar-gregorian-from-absolute d2)))
(y1 (calendar-extract-year (calendar-gregorian-from-absolute d1)))
(y2 (calendar-extract-year (calendar-gregorian-from-absolute d2)))
(y ; year of base date
(if (or (= y1 y2) (> month 9))
y1
@ -340,7 +349,7 @@ nil, or if the date is not visible, there is no holiday."
(let ((m displayed-month)
(y displayed-year)
year date)
(increment-calendar-month m y -1)
(calendar-increment-month m y -1)
(holiday-filter-visible-calendar
(list
(progn
@ -368,7 +377,7 @@ arguments, then it returns the value appropriate for advent itself."
(let* ((year displayed-year)
(month displayed-month)
(advent (progn
(increment-calendar-month month year -1)
(calendar-increment-month month year -1)
(calendar-gregorian-from-absolute
(+ n
(calendar-dayname-on-or-before
@ -444,8 +453,8 @@ is non-nil)."
(let* ((m displayed-month)
(y displayed-year)
(julian-year (progn
(increment-calendar-month m y 1)
(extract-calendar-year
(calendar-increment-month m y 1)
(calendar-extract-year
(calendar-julian-from-absolute
(calendar-absolute-from-gregorian
(list m (calendar-last-day-of-month m y) y))))))

22
lisp/calendar/lunar.el
View file

@ -129,7 +129,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(date (+ date adjustment))
(date (+ date (/ (- calendar-time-zone
(solar-ephemeris-correction
(extract-calendar-year
(calendar-extract-year
(calendar-gregorian-from-absolute
(truncate date)))))
60.0 24.0)))
@ -145,10 +145,10 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(start-month month)
(start-year year)
(end-date (progn
(increment-calendar-month end-month end-year 3)
(calendar-increment-month end-month end-year 3)
(list (list end-month 1 end-year))))
(start-date (progn
(increment-calendar-month start-month start-year -1)
(calendar-increment-month start-month start-year -1)
(list (list start-month
(calendar-last-day-of-month
start-month start-year)
@ -176,7 +176,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
((= 2 phase) "Full Moon")
((= 3 phase) "Last Quarter Moon")))
(defvar displayed-month) ; from generate-calendar
(defvar displayed-month) ; from calendar-generate
(defvar displayed-year)
;;;###cal-autoload
@ -188,8 +188,8 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(y1 displayed-year)
(m2 displayed-month)
(y2 displayed-year))
(increment-calendar-month m1 y1 -1)
(increment-calendar-month m2 y2 1)
(calendar-increment-month m1 y1 -1)
(calendar-increment-month m2 y2 1)
(calendar-in-read-only-buffer lunar-phases-buffer
(calendar-set-mode-line
(if (= y1 y2)
@ -221,8 +221,8 @@ This function is suitable for execution in a .emacs file."
(save-excursion
(let* ((date (if arg (calendar-read-date t)
(calendar-current-date)))
(displayed-month (extract-calendar-month date))
(displayed-year (extract-calendar-year date)))
(displayed-month (calendar-extract-month date))
(displayed-year (calendar-extract-year date)))
(calendar-phases-of-moon))))
(defvar date)
@ -237,7 +237,7 @@ use when highlighting the day in the calendar."
(let* ((index (* 4
(truncate
(* 12.3685
(+ (extract-calendar-year date)
(+ (calendar-extract-year date)
( / (calendar-day-number date)
366.0)
-1900)))))
@ -353,7 +353,7 @@ use when highlighting the day in the calendar."
(newJDE (+ JDE correction additional)))
(+ newJDE
(- (solar-ephemeris-correction
(extract-calendar-year
(calendar-extract-year
(calendar-gregorian-from-absolute
(floor (calendar-astro-to-absolute newJDE))))))
(/ calendar-time-zone 60.0 24.0))))
@ -369,7 +369,7 @@ as governed by the values of `calendar-daylight-savings-starts',
`calendar-time-zone'."
(let* ((date (calendar-gregorian-from-absolute
(floor (calendar-astro-to-absolute d))))
(year (+ (extract-calendar-year date)
(year (+ (calendar-extract-year date)
(/ (calendar-day-number date) 365.25)))
(k (floor (* (- year 2000.0) 12.3685)))
(date (lunar-new-moon-time k))

6
lisp/calendar/solar.el
View file

@ -725,7 +725,7 @@ The values of `calendar-daylight-savings-starts',
(/ calendar-time-zone 60.0 24.0))))
;; Get Ephemeris Time.
(date (+ date (solar-ephemeris-correction
(extract-calendar-year
(calendar-extract-year
(calendar-gregorian-from-absolute
(floor
(calendar-astro-to-absolute
@ -979,7 +979,7 @@ solstice. These formulae are only to be used between 1000 BC and 3000 AD."
(* -0.00823 z z z)
(* 0.00032 z z z z)))))))
(defvar displayed-month) ; from generate-calendar
(defvar displayed-month) ; from calendar-generate
(defvar displayed-year)
;;;###holiday-autoload
@ -996,7 +996,7 @@ Requires floating point."
(if calendar-time-zone calendar-daylight-savings-ends))
(calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
(k (progn
(increment-calendar-month m y (cond ((= 1 (% m 3)) -1)
(calendar-increment-month m y (cond ((= 1 (% m 3)) -1)
((= 2 (% m 3)) 1)
(t 0)))
(1- (/ m 3))))