Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
e803eab7
Commit
e803eab7
authored
Apr 07, 2008
by
Glenn Morris
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Update for calendar.el name changes.
parent
1b73d7f3
Changes
19
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
19 changed files
with
407 additions
and
398 deletions
+407
-398
lisp/calendar/cal-bahai.el
lisp/calendar/cal-bahai.el
+14
-14
lisp/calendar/cal-china.el
lisp/calendar/cal-china.el
+7
-7
lisp/calendar/cal-coptic.el
lisp/calendar/cal-coptic.el
+7
-7
lisp/calendar/cal-dst.el
lisp/calendar/cal-dst.el
+4
-4
lisp/calendar/cal-french.el
lisp/calendar/cal-french.el
+7
-7
lisp/calendar/cal-hebrew.el
lisp/calendar/cal-hebrew.el
+41
-41
lisp/calendar/cal-html.el
lisp/calendar/cal-html.el
+7
-7
lisp/calendar/cal-islam.el
lisp/calendar/cal-islam.el
+14
-14
lisp/calendar/cal-iso.el
lisp/calendar/cal-iso.el
+8
-8
lisp/calendar/cal-julian.el
lisp/calendar/cal-julian.el
+3
-3
lisp/calendar/cal-menu.el
lisp/calendar/cal-menu.el
+9
-9
lisp/calendar/cal-move.el
lisp/calendar/cal-move.el
+30
-30
lisp/calendar/cal-persia.el
lisp/calendar/cal-persia.el
+7
-7
lisp/calendar/cal-tex.el
lisp/calendar/cal-tex.el
+119
-119
lisp/calendar/cal-x.el
lisp/calendar/cal-x.el
+4
-4
lisp/calendar/diary-lib.el
lisp/calendar/diary-lib.el
+70
-70
lisp/calendar/holidays.el
lisp/calendar/holidays.el
+42
-33
lisp/calendar/lunar.el
lisp/calendar/lunar.el
+11
-11
lisp/calendar/solar.el
lisp/calendar/solar.el
+3
-3
No files found.
lisp/calendar/cal-bahai.el
View file @
e803eab7
...
...
@@ -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
))
...
...
lisp/calendar/cal-china.el
View file @
e803eab7
...
...
@@ -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
)
...
...
lisp/calendar/cal-coptic.el
View file @
e803eab7
...
...
@@ -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
)
...
...
lisp/calendar/cal-dst.el
View file @
e803eab7
...
...
@@ -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
))
...
...
lisp/calendar/cal-french.el
View file @
e803eab7
...
...
@@ -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
))))))))
...
...
lisp/calendar/cal-hebrew.el
View file @
e803eab7
...
...
@@ -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
cal
endar
-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
)))
...
...
lisp/calendar/cal-html.el
View file @
e803eab7
...
...
@@ -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
)
...
...
lisp/calendar/cal-islam.el
View file @
e803eab7
...
...
@@ -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
))
...
...
lisp/calendar/cal-iso.el
View file @
e803eab7
...
...
@@ -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
)))