aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy1993-06-22 03:22:12 +0000
committerJim Blandy1993-06-22 03:22:12 +0000
commit354d06443ef97ebf36e64e8ca329d5553aab06a6 (patch)
treedf4a6a69dae6f27664bf28b8544df98922ccb8e7
parentaac180a7b1f7f1c05448e538c95ab936c71009c2 (diff)
downloademacs-354d06443ef97ebf36e64e8ca329d5553aab06a6.tar.gz
emacs-354d06443ef97ebf36e64e8ca329d5553aab06a6.zip
* calendar.el (calendar-version): Update to 5.1. Fixed a variety
of spelling error in comments and doc strings. (calendar-sexp-debug): New variable to turn off error catching. (calendar-absolute-from-gregorian): Removed unused vars month, day. (view-calendar-holidays-initially, all-hebrew-calendar-holidays, all-christian-calendar-holidays, all-christian-islamic-holidays, diary-nonmarking-symbol, hebrew-diary-entry-symbol, islamic-diary-entry-symbol, diary-include-string, abbreviated-calendar-year, european-calendar-style, european-calendar-display-form, american-calendar-display-form, calendar-date-display-form, print-diary-entries-hook, list-diary-entries-hook, nongregorian-diary-listing-hook, nongregorian-diary-marking-hook, diary-list-include-blanks, holidays-in-diary-buffer, general-holidays, increment-calendar-month, calendar-sum, calendar-string-spread, calendar-absolute-from-iso, calendar-print-iso-date, hebrew-calendar-elapsed-days, list-yahrzeit-dates, calendar-print-astro-day-number): Fix doc strings. (calendar-nth-named-day): Rewritten to include optional day of month. (general-holidays, calendar-holidays, hebrew-holidays, christian-holidays, islamic-holidays, solar-holidays): Rewritten to include require of cal-dst.el and to show the time of the change to/from daylight savings time. (calendar-current-time-zone, calendar-time-zone, calendar-daylight-time-offset, calendar-standard-time-zone-name, calendar-daylight-time-zone-name, calendar-daylight-savings-starts, calendar-daylight-savings-ends, calendar-daylight-savings-switchover-time): Moved to cal-dst.el. (calendar-location-name, calendar-time-display-form, calendar-latitude, calendar-longitude): Moved to solar.el. (calendar-holidays): Unquote it!
-rw-r--r--lisp/calendar/calendar.el721
1 files changed, 319 insertions, 402 deletions
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 1b2c4fe8bb0..f52b957f170 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -8,7 +8,7 @@
8;; Hebrew calendar, Islamic calendar, ISO calendar, Julian day number, 8;; Hebrew calendar, Islamic calendar, ISO calendar, Julian day number,
9;; diary, holidays 9;; diary, holidays
10 10
11(defconst calendar-version "Version 5, released August 10, 1992") 11(defconst calendar-version "Version 5.1, released June 18, 1993")
12 12
13;; This file is part of GNU Emacs. 13;; This file is part of GNU Emacs.
14 14
@@ -57,6 +57,7 @@
57;; holidays.el Holiday functions 57;; holidays.el Holiday functions
58;; cal-french.el French Revolutionary calendar 58;; cal-french.el French Revolutionary calendar
59;; cal-mayan.el Mayan calendars 59;; cal-mayan.el Mayan calendars
60;; cal-dst.el Daylight savings time rules
60;; solar.el Sunrise/sunset, equinoxes/solstices 61;; solar.el Sunrise/sunset, equinoxes/solstices
61;; lunar.el Phases of the moon 62;; lunar.el Phases of the moon
62;; appt.el Appointment notification 63;; appt.el Appointment notification
@@ -133,9 +134,9 @@ The marking symbol is specified by the variable `diary-entry-marker'.")
133 134
134;;;###autoload 135;;;###autoload
135(defvar view-calendar-holidays-initially nil 136(defvar view-calendar-holidays-initially nil
136 "*If t, the holidays for the current three month period will be displayed 137 "*If t, holidays for current three month period will be displayed on entry.
137on entry. The holidays are displayed in another window when the calendar is 138The holidays are displayed in another window when the calendar is first
138first displayed.") 139displayed.")
139 140
140;;;###autoload 141;;;###autoload
141(defvar mark-holidays-in-calendar nil 142(defvar mark-holidays-in-calendar nil
@@ -148,24 +149,33 @@ The marking symbol is specified by the variable `calendar-holiday-marker'.")
148 149
149;;;###autoload 150;;;###autoload
150(defvar all-hebrew-calendar-holidays nil 151(defvar all-hebrew-calendar-holidays nil
151 "*If nil, the holidays from the Hebrew calendar that are shown will 152 "*If nil, show only major holidays from the Hebrew calendar.
152include only those days of such major interest as to appear on secular 153
153calendars. If t, the holidays shown in the calendar will include all 154If nil, the only holidays from the Hebrew calendar shown will be those days of
154special days that would be shown on a complete Hebrew calendar.") 155such major interest as to appear on secular calendars.
156
157If t, the holidays shown in the calendar will include all special days that
158would be shown on a complete Hebrew calendar.")
155 159
156;;;###autoload 160;;;###autoload
157(defvar all-christian-calendar-holidays nil 161(defvar all-christian-calendar-holidays nil
158 "*If nil, the holidays from the Christian calendar that are shown will 162 "*If nil, show only major holidays from the Christian calendar.
159include only those days of such major interest as to appear on secular 163
160calendars. If t, the holidays shown in the calendar will include all 164If nil, the only holidays from the Christian calendar shown will be those days
161special days that would be shown on a complete Christian calendar.") 165of such major interest as to appear on secular calendars.
166
167If t, the holidays shown in the calendar will include all special days that
168would be shown on a complete Christian calendar.")
162 169
163;;;###autoload 170;;;###autoload
164(defvar all-islamic-calendar-holidays nil 171(defvar all-islamic-calendar-holidays nil
165 "*If nil, the holidays from the Islamic calendar that are shown will 172 "*If nil, show only major holidays from the Islamic calendar.
166include only those days of such major interest as to appear on secular 173
167calendars. If t, the holidays shown in the calendar will include all 174If nil, the only holidays from the Islamic calendar shown will be those days
168special days that would be shown on a complete Islamic calendar.") 175of such major interest as to appear on secular calendars.
176
177If t, the holidays shown in the calendar will include all special days that
178would be shown on a complete Islamic calendar.")
169 179
170;;;###autoload 180;;;###autoload
171(defvar calendar-load-hook nil 181(defvar calendar-load-hook nil
@@ -307,24 +317,20 @@ details, see the documentation for the variable `list-diary-entries-hook'.")
307 317
308;;;###autoload 318;;;###autoload
309(defvar diary-nonmarking-symbol "&" 319(defvar diary-nonmarking-symbol "&"
310 "*The symbol used to indicate that a diary entry is not to be marked in the 320 "*Symbol indicating that a diary entry is not to be marked in the calendar.")
311calendar window.")
312 321
313;;;###autoload 322;;;###autoload
314(defvar hebrew-diary-entry-symbol "H" 323(defvar hebrew-diary-entry-symbol "H"
315 "*The symbol used to indicate that a diary entry is according to the 324 "*Symbol indicating a diary entry according to the Hebrew calendar.")
316Hebrew calendar.")
317 325
318;;;###autoload 326;;;###autoload
319(defvar islamic-diary-entry-symbol "I" 327(defvar islamic-diary-entry-symbol "I"
320 "*The symbol used to indicate that a diary entry is according to the 328 "*Symbol indicating a diary entry according to the Islamic calendar.")
321Islamic calendar.")
322 329
323;;;###autoload 330;;;###autoload
324(defvar diary-include-string "#include" 331(defvar diary-include-string "#include"
325 "*The string used to indicate the inclusion of another file of diary entries 332 "*The string indicating inclusion of another file of diary entries.
326in diary-file. See the documentation for the function 333See the documentation for the function `include-other-diary-files'.")
327`include-other-diary-files'.")
328 334
329;;;###autoload 335;;;###autoload
330(defvar sexp-diary-entry-symbol "%%" 336(defvar sexp-diary-entry-symbol "%%"
@@ -333,15 +339,15 @@ See the documentation for the function `list-sexp-diary-entries'.")
333 339
334;;;###autoload 340;;;###autoload
335(defvar abbreviated-calendar-year t 341(defvar abbreviated-calendar-year t
336 "*Interpret a two-digit year DD in a diary entry as being either 19DD or 342 "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
33720DD, as appropriate, for the Gregorian calendar; similarly for the Hebrew and 343For the Gregorian calendar; similarly for the Hebrew and Islamic calendars.
338Islamic calendars. If this variable is nil, years must be written in full.") 344If this variable is nil, years must be written in full.")
339 345
340;;;###autoload 346;;;###autoload
341(defvar european-calendar-style nil 347(defvar european-calendar-style nil
342 "*Use the European style of dates in the diary and in any displays. If this 348 "*Use the European style of dates in the diary and in any displays.
343variable is t, a date 1/2/1990 would be interpreted as February 1, 1990. 349If this variable is t, a date 1/2/1990 would be interpreted as February 1,
344The accepted European date styles are 3501990. The accepted European date styles are
345 351
346 DAY/MONTH 352 DAY/MONTH
347 DAY/MONTH/YEAR 353 DAY/MONTH/YEAR
@@ -403,28 +409,26 @@ a portion of the first word of the diary entry.")
403;;;###autoload 409;;;###autoload
404(defvar european-calendar-display-form 410(defvar european-calendar-display-form
405 '((if dayname (concat dayname ", ")) day " " monthname " " year) 411 '((if dayname (concat dayname ", ")) day " " monthname " " year)
406 "*The pseudo-pattern that governs the way a Gregorian date is formatted 412 "*Pseudo-pattern governing the way a date appears in the European style.
407in the European style. See the documentation of calendar-date-display-forms 413See the documentation of calendar-date-display-forms for an explanation.")
408for an explanation.")
409 414
410;;;###autoload 415;;;###autoload
411(defvar american-calendar-display-form 416(defvar american-calendar-display-form
412 '((if dayname (concat dayname ", ")) monthname " " day ", " year) 417 '((if dayname (concat dayname ", ")) monthname " " day ", " year)
413 "*The pseudo-pattern that governs the way a Gregorian date is formatted 418 "*Pseudo-pattern governing the way a date appears in the American style.
414in the American style. See the documentation of calendar-date-display-forms 419See the documentation of calendar-date-display-forms for an explanation.")
415for an explanation.")
416 420
417;;;###autoload 421;;;###autoload
418(defvar calendar-date-display-form 422(defvar calendar-date-display-form
419 (if european-calendar-style 423 (if european-calendar-style
420 european-calendar-display-form 424 european-calendar-display-form
421 american-calendar-display-form) 425 american-calendar-display-form)
422 "*The pseudo-pattern that governs the way a Gregorian date is formatted 426 "*Pseudo-pattern governing the way a date appears.
423as a string by the function `calendar-date-string'. A pseudo-pattern is a 427
424list of expressions that can involve the keywords `month', `day', and 428Used by the function `calendar-date-string', a pseudo-pattern is a list of
425`year', all numbers in string form, and `monthname' and `dayname', both 429expressions that can involve the keywords `month', `day', and `year', all
426alphabetic strings. For example, the ISO standard would use the pseudo- 430numbers in string form, and `monthname' and `dayname', both alphabetic
427pattern 431strings. For example, the ISO standard would use the pseudo- pattern
428 432
429 '(year \"-\" month \"-\" day) 433 '(year \"-\" month \"-\" day)
430 434
@@ -440,164 +444,6 @@ would give the usual American style in fixed-length fields.
440 444
441See the documentation of the function `calendar-date-string'.") 445See the documentation of the function `calendar-date-string'.")
442 446
443;;;###autoload
444(defvar calendar-time-display-form
445 '(12-hours ":" minutes am-pm
446 (if time-zone " (") time-zone (if time-zone ")"))
447 "*The pseudo-pattern that governs the way a time of day is formatted.
448
449A pseudo-pattern is a list of expressions that can involve the keywords
450`12-hours', `24-hours', and `minutes', all numbers in string form,
451and `am-pm' and `time-zone', both alphabetic strings.
452
453For example, the form
454
455 '(24-hours \":\" minutes
456 (if time-zone \" (\") time-zone (if time-zone \")\"))
457
458would give military-style times like `21:07 (UT)'.")
459
460;;;###autoload
461(defvar calendar-latitude nil
462 "*Latitude of `calendar-location-name' in degrees, + north, - south.
463For example, 40.7 for New York City.")
464
465;;;###autoload
466(defvar calendar-longitude nil
467 "*Longitude of `calendar-location-name' in degrees, + east, - west.
468For example, -74.0 for New York City.")
469
470;;;###autoload
471(defvar calendar-location-name
472 '(let ((float-output-format "%.1f"))
473 (format "%s%s, %s%s"
474 (abs calendar-latitude)
475 (if (> calendar-latitude 0) "N" "S")
476 (abs calendar-longitude)
477 (if (> calendar-longitude 0) "E" "W")))
478 "*An expression that evaluates to the name of the location at
479`calendar-longitude', calendar-latitude'. Default value is just the latitude,
480longitude pair.")
481
482(defun calendar-current-time-zone ()
483 "Return the UTC difference, dst offset, and names for the current time zone.
484
485Returns a list of the form (UTC-DIFF DST-OFFSET STD-ZONE DST-ZONE), based on
486a heuristic probing of what the system knows:
487
488UTC-DIFF is an integer specifying the number of minutes difference between
489 standard time in the current time zone and Coordinated Universal Time
490 (Greenwich Mean Time). A negative value means west of Greenwich.
491DST-OFFSET is an integer giving the daylight savings time offset in minutes.
492STD-ZONE is a string giving the name of the time zone when no seasonal time
493 adjustment is in effect.
494DST-ZONE is a string giving the name of the time zone when there is a seasonal
495 time adjustment in effect.
496
497If the local area does not use a seasonal time adjustment, OFFSET is 0, and
498STD-ZONE and DST-ZONE are equal.
499
500Some operating systems cannot provide all this information to Emacs; in this
501case, `calendar-current-time-zone' returns a list containing nil for the data
502it can't find."
503 (let* ((now (current-time))
504 (now-zone (current-time-zone now))
505 (now-utc-diff (car now-zone))
506 (now-name (car (cdr now-zone)))
507 probe-zone
508 (probe-utc-diff now-utc-diff)
509 (i 1))
510 ;; Heuristic: probe the time zone offset in the next three calendar
511 ;; quarters, looking for a time zone offset different from now.
512 ;; There about 120 * 2^16 seconds in a quarter year
513 (while (and (< i 4) (eq now-utc-diff probe-utc-diff))
514 (setq probe-zone (current-time-zone (list (+ (car now) (* i 120)) 0)))
515 (setq probe-utc-diff (car probe-zone))
516 (setq i (1+ i)))
517 (if (or (eq now-utc-diff probe-utc-diff)
518 (not now-utc-diff)
519 (not probe-utc-diff))
520 ;; No change found
521 (list (and now-utc-diff (/ now-utc-diff 60)) 0 now-name now-name)
522 ;; Found a different utc-diff
523 (let ((utc-diff (min now-utc-diff probe-utc-diff))
524 (probe-name (car (cdr probe-zone))))
525 (list (/ utc-diff 60)
526 (/ (abs (- now-utc-diff probe-utc-diff)) 60)
527 (if (eq utc-diff now-utc-diff) now-name probe-name)
528 (if (eq utc-diff now-utc-diff) probe-name now-name))))))
529
530;;; The following six defvars relating to daylight savings time should NOT be
531;;; marked to go into loaddefs.el where they would be evaluated when Emacs is
532;;; dumped. These variables' appropriate values really on the conditions under
533;;; which the code is INVOKED; so it's inappropriate to initialize them when
534;;; Emacs is dumped---they should be initialized when calendar.el is loaded.
535
536(defvar calendar-time-zone (car (calendar-current-time-zone))
537 "*Number of minutes difference between local standard time at
538`calendar-location-name' and Coordinated Universal (Greenwich) Time. For
539example, -300 for New York City, -480 for Los Angeles.")
540
541(defvar calendar-daylight-time-offset (car (cdr (calendar-current-time-zone)))
542 "*A sexp in the variable `year' that gives the number of minutes difference
543between daylight savings time and standard time.
544
545Should be set to 0 if locale has no daylight savings time.")
546
547(defvar calendar-standard-time-zone-name
548 (car (nthcdr 2 (calendar-current-time-zone)))
549 "*Abbreviated name of standard time zone at `calendar-location-name'.
550For example, \"EST\" in New York City, \"PST\" for Los Angeles.")
551
552(defvar calendar-daylight-time-zone-name
553 (car (nthcdr 3 (calendar-current-time-zone)))
554 "*Abbreviated name of daylight-savings time zone at `calendar-location-name'.
555For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.")
556
557(defvar calendar-daylight-savings-starts
558 (if (not (eq calendar-daylight-time-offset 0))
559 '(calendar-nth-named-day 1 0 4 year))
560 "*A sexp in the variable `year' that gives the Gregorian date, in the form
561of a list (month day year), on which daylight savings time starts. This is
562used to determine the starting date of daylight savings time for the holiday
563list and for correcting times of day in the solar and lunar calculations.
564
565For example, if daylight savings time is mandated to start on October 1,
566you would set `calendar-daylight-savings-starts' to
567
568 '(10 1 year)
569
570For a more complex example, if daylight savings time begins on the first of
571Nisan on the Hebrew calendar, we would set `calendar-daylight-savings-starts'
572to
573
574 '(calendar-gregorian-from-absolute
575 (calendar-absolute-from-hebrew
576 (list 1 1 (+ year 3760))))
577
578because Nisan is the first month in the Hebrew calendar.
579
580If the locale never uses daylight savings time, set this to nil.")
581
582(defvar calendar-daylight-savings-ends
583 (if (not (eq calendar-daylight-time-offset 0))
584 '(calendar-nth-named-day -1 0 10 year))
585 "*An expression in the variable `year' that gives the Gregorian date, in the
586form of a list (month day year), on which daylight savings time ends. This
587is used to determine the ending date of daylight savings time for the holiday
588list and for correcting times of day in the solar and lunar calculations.
589
590The default value is the American rule of the last Sunday in October,
591
592If the locale never uses daylight savings time, set this to nil.
593
594See the documentation for `calendar-daylight-savings-starts' for other
595examples.")
596
597(defvar calendar-daylight-savings-switchover-time 120
598 "*A sexp in the variable `year' that gives the number of minutes after
599midnight that daylight savings time begins and ends.")
600
601(defun european-calendar () 447(defun european-calendar ()
602 "Set the interpretation and display of dates to the European style." 448 "Set the interpretation and display of dates to the European style."
603 (interactive) 449 (interactive)
@@ -616,17 +462,16 @@ midnight that daylight savings time begins and ends.")
616 462
617;;;###autoload 463;;;###autoload
618(defvar print-diary-entries-hook 'lpr-buffer 464(defvar print-diary-entries-hook 'lpr-buffer
619 "*List of functions to be called after a temporary buffer is prepared with 465 "*List of functions called after a temporary diary buffer is prepared.
620the diary entries currently visible in the diary buffer. The default just 466The buffer shows only the diary entries currently visible in the diary
621does the printing. Other uses might include, for example, rearranging the 467buffer. The default just does the printing. Other uses might include, for
622lines into order by day and time, saving the buffer instead of deleting it, or 468example, rearranging the lines into order by day and time, saving the buffer
623changing the function used to do the printing.") 469instead of deleting it, or changing the function used to do the printing.")
624 470
625;;;###autoload 471;;;###autoload
626(defvar list-diary-entries-hook nil 472(defvar list-diary-entries-hook nil
627 "*List of functions to be called after the diary file is culled for 473 "*List of functions called after diary file is culled for relevant entries.
628relevant entries. It is to be used for diary entries that are not found in 474It is to be used for diary entries that are not found in the diary file.
629the diary file.
630 475
631A function `include-other-diary-files' is provided for use as the value of 476A function `include-other-diary-files' is provided for use as the value of
632this hook. This function enables you to use shared diary files together 477this hook. This function enables you to use shared diary files together
@@ -675,10 +520,11 @@ diary buffer, set the variable `diary-list-include-blanks' to t.")
675 520
676;;;###autoload 521;;;###autoload
677(defvar nongregorian-diary-listing-hook nil 522(defvar nongregorian-diary-listing-hook nil
678 "*List of functions to be called for the diary file and included files as 523 "*List of functions called for listing diary file and included files.
679they are processed for listing diary entries. You can use any or all of 524As the files are processed for diary entries, these functions are used to cull
680`list-hebrew-diary-entries' and `list-islamic-diary-entries'. The 525relevant entries. You can use either or both of `list-hebrew-diary-entries'
681documentation for these functions describes the style of such diary entries.") 526and `list-islamic-diary-entries'. The documentation for these functions
527describes the style of such diary entries.")
682 528
683;;;###autoload 529;;;###autoload
684(defvar mark-diary-entries-hook nil 530(defvar mark-diary-entries-hook nil
@@ -697,46 +543,48 @@ function `include-other-diary-files' as part of the list-diary-entries-hook.")
697 543
698;;;###autoload 544;;;###autoload
699(defvar nongregorian-diary-marking-hook nil 545(defvar nongregorian-diary-marking-hook nil
700 "*List of functions to be called as the diary file and included files are 546 "*List of functions called for marking diary file and included files.
701processed for marking diary entries. You can use either or both of 547As the files are processed for diary entries, these functions are used to cull
702mark-hebrew-diary-entries and mark-islamic-diary-entries. The documentation 548relevant entries. You can use either or both of `mark-hebrew-diary-entries'
703for these functions describes the style of such diary entries.") 549and `mark-islamic-diary-entries'. The documentation for these functions
550describes the style of such diary entries.")
704 551
705;;;###autoload 552;;;###autoload
706(defvar diary-list-include-blanks nil 553(defvar diary-list-include-blanks nil
707 "*If nil, do not include days with no diary entry in the list of diary 554 "*If nil, do not include days with no diary entry in the list of diary entries.
708entries. Such days will then not be shown in the the fancy diary buffer, 555Such days will then not be shown in the the fancy diary buffer, even if they
709even if they are holidays.") 556are holidays.")
710 557
711;;;###autoload 558;;;###autoload
712(defvar holidays-in-diary-buffer t 559(defvar holidays-in-diary-buffer t
713 "*If t, the holidays will be indicated in the mode line of the diary buffer 560 "*If t, the holidays will be indicated in the diary display.
714(or in the fancy diary buffer next to the date). This slows down the diary 561The holidays will be given in the mode line of the diary buffer, or in the
715functions somewhat; setting it to nil will make the diary display faster.") 562fancy diary buffer next to the date. This slows down the diary functions
563somewhat; setting it to nil will make the diary display faster.")
716 564
717(defvar calendar-mark-ring nil) 565(defvar calendar-mark-ring nil)
718 566
719;;;###autoload 567;;;###autoload
720(defvar general-holidays 568(defvar general-holidays
721 '((fixed 1 1 "New Year's Day") 569 '((holiday-fixed 1 1 "New Year's Day")
722 (float 1 1 3 "Martin Luther King Day") 570 (holiday-float 1 1 3 "Martin Luther King Day")
723 (fixed 2 2 "Ground Hog Day") 571 (holiday-fixed 2 2 "Ground Hog Day")
724 (fixed 2 14 "Valentine's Day") 572 (holiday-fixed 2 14 "Valentine's Day")
725 (float 2 1 3 "President's Day") 573 (holiday-float 2 1 3 "President's Day")
726 (fixed 3 17 "St. Patrick's Day") 574 (holiday-fixed 3 17 "St. Patrick's Day")
727 (fixed 4 1 "April Fool's Day") 575 (holiday-fixed 4 1 "April Fool's Day")
728 (float 5 0 2 "Mother's Day") 576 (holiday-float 5 0 2 "Mother's Day")
729 (float 5 1 -1 "Memorial Day") 577 (holiday-float 5 1 -1 "Memorial Day")
730 (fixed 6 14 "Flag Day") 578 (holiday-fixed 6 14 "Flag Day")
731 (float 6 0 3 "Father's Day") 579 (holiday-float 6 0 3 "Father's Day")
732 (fixed 7 4 "Independence Day") 580 (holiday-fixed 7 4 "Independence Day")
733 (float 9 1 1 "Labor Day") 581 (holiday-float 9 1 1 "Labor Day")
734 (float 10 1 2 "Columbus Day") 582 (holiday-float 10 1 2 "Columbus Day")
735 (fixed 10 31 "Halloween") 583 (holiday-fixed 10 31 "Halloween")
736 (fixed 11 11 "Veteran's Day") 584 (holiday-fixed 11 11 "Veteran's Day")
737 (float 11 4 4 "Thanksgiving")) 585 (holiday-float 11 4 4 "Thanksgiving"))
738 "*General holidays. Default value is for the United States. See the 586 "*General holidays. Default value is for the United States.
739documentation for `calendar-holidays' for details.") 587See the documentation for `calendar-holidays' for details.")
740 588
741;;;###autoload 589;;;###autoload
742(defvar local-holidays nil 590(defvar local-holidays nil
@@ -750,38 +598,40 @@ See the documentation for `calendar-holidays' for details.")
750 598
751;;;###autoload 599;;;###autoload
752(defvar hebrew-holidays 600(defvar hebrew-holidays
753 '((rosh-hashanah-etc) 601 '((holiday-rosh-hashanah-etc)
754 (if all-hebrew-calendar-holidays 602 (if all-hebrew-calendar-holidays
755 (julian 11 603 (holiday-julian
756 (let* ((m displayed-month) 604 11
757 (y displayed-year) 605 (let* ((m displayed-month)
758 (year)) 606 (y displayed-year)
759 (increment-calendar-month m y -1) 607 (year))
760 (let ((year (extract-calendar-year 608 (increment-calendar-month m y -1)
761 (calendar-julian-from-absolute 609 (let ((year (extract-calendar-year
762 (calendar-absolute-from-gregorian 610 (calendar-julian-from-absolute
763 (list m 1 y)))))) 611 (calendar-absolute-from-gregorian
764 (if (zerop (% (1+ year) 4)) 612 (list m 1 y))))))
765 22 613 (if (zerop (% (1+ year) 4))
766 21))) "\"Tal Umatar\" (evening)")) 614 22
615 21))) "\"Tal Umatar\" (evening)"))
767 (if all-hebrew-calendar-holidays 616 (if all-hebrew-calendar-holidays
768 (hanukkah) 617 (holiday-hanukkah)
769 (hebrew 9 25 "Hanukkah")) 618 (holiday-hebrew 9 25 "Hanukkah"))
770 (if all-hebrew-calendar-holidays 619 (if all-hebrew-calendar-holidays
771 (hebrew 10 620 (holiday-hebrew
772 (let ((h-year (extract-calendar-year 621 10
773 (calendar-hebrew-from-absolute 622 (let ((h-year (extract-calendar-year
774 (calendar-absolute-from-gregorian 623 (calendar-hebrew-from-absolute
775 (list displayed-month 28 displayed-year)))))) 624 (calendar-absolute-from-gregorian
776 (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year)) 625 (list displayed-month 28 displayed-year))))))
777 7) 626 (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year))
778 6) 627 7)
779 11 10)) 628 6)
780 "Tzom Teveth")) 629 11 10))
630 "Tzom Teveth"))
781 (if all-hebrew-calendar-holidays 631 (if all-hebrew-calendar-holidays
782 (hebrew 11 15 "Tu B'Shevat")) 632 (holiday-hebrew 11 15 "Tu B'Shevat"))
783 (if all-hebrew-calendar-holidays 633 (if all-hebrew-calendar-holidays
784 (hebrew 634 (holiday-hebrew
785 11 635 11
786 (let ((m displayed-month) 636 (let ((m displayed-month)
787 (y displayed-year)) 637 (y displayed-year))
@@ -808,7 +658,7 @@ See the documentation for `calendar-holidays' for details.")
808 (day (extract-calendar-day s-s))) 658 (day (extract-calendar-day s-s)))
809 day)) 659 day))
810 "Shabbat Shirah")) 660 "Shabbat Shirah"))
811 (passover-etc) 661 (holiday-passover-etc)
812 (if (and all-hebrew-calendar-holidays 662 (if (and all-hebrew-calendar-holidays
813 (let* ((m displayed-month) 663 (let* ((m displayed-month)
814 (y displayed-year) 664 (y displayed-year)
@@ -819,54 +669,57 @@ See the documentation for `calendar-holidays' for details.")
819 (calendar-absolute-from-gregorian 669 (calendar-absolute-from-gregorian
820 (list m 1 y)))))) 670 (list m 1 y))))))
821 (= 21 (% year 28))))) 671 (= 21 (% year 28)))))
822 (julian 3 26 "Kiddush HaHamah")) 672 (holiday-julian 3 26 "Kiddush HaHamah"))
823 (if all-hebrew-calendar-holidays 673 (if all-hebrew-calendar-holidays
824 (tisha-b-av-etc))) 674 (holiday-tisha-b-av-etc)))
825 "*Jewish holidays. 675 "*Jewish holidays.
826See the documentation for `calendar-holidays' for details.") 676See the documentation for `calendar-holidays' for details.")
827 677
828;;;###autoload 678;;;###autoload
829(defvar christian-holidays 679(defvar christian-holidays
830 '((if all-christian-calendar-holidays 680 '((if all-christian-calendar-holidays
831 (fixed 1 6 "Epiphany")) 681 (holiday-fixed 1 6 "Epiphany"))
832 (easter-etc) 682 (holiday-easter-etc)
833 (if all-christian-calendar-holidays 683 (if all-christian-calendar-holidays
834 (greek-orthodox-easter)) 684 (holiday-greek-orthodox-easter))
835 (if all-christian-calendar-holidays 685 (if all-christian-calendar-holidays
836 (fixed 8 15 "Assumption")) 686 (holiday-fixed 8 15 "Assumption"))
837 (if all-christian-calendar-holidays 687 (if all-christian-calendar-holidays
838 (advent)) 688 (holiday-advent))
839 (fixed 12 25 "Christmas") 689 (holiday-fixed 12 25 "Christmas")
840 (if all-christian-calendar-holidays 690 (if all-christian-calendar-holidays
841 (julian 12 25 "Eastern Orthodox Christmas"))) 691 (holiday-julian 12 25 "Eastern Orthodox Christmas")))
842 "*Christian holidays. 692 "*Christian holidays.
843See the documentation for `calendar-holidays' for details.") 693See the documentation for `calendar-holidays' for details.")
844 694
845;;;###autoload 695;;;###autoload
846(defvar islamic-holidays 696(defvar islamic-holidays
847 '((islamic 1 1 (format "Islamic New Year %d" 697 '((holiday-islamic
848 (let ((m displayed-month) 698 1 1
849 (y displayed-year)) 699 (format "Islamic New Year %d"
850 (increment-calendar-month m y 1) 700 (let ((m displayed-month)
851 (extract-calendar-year 701 (y displayed-year))
852 (calendar-islamic-from-absolute 702 (increment-calendar-month m y 1)
853 (calendar-absolute-from-gregorian 703 (extract-calendar-year
854 (list m (calendar-last-day-of-month m y) y))))))) 704 (calendar-islamic-from-absolute
705 (calendar-absolute-from-gregorian
706 (list
707 m (calendar-last-day-of-month m y) y)))))))
855 (if all-islamic-calendar-holidays 708 (if all-islamic-calendar-holidays
856 (islamic 1 10 "Ashura")) 709 (holiday-islamic 1 10 "Ashura"))
857 (if all-islamic-calendar-holidays 710 (if all-islamic-calendar-holidays
858 (islamic 3 12 "Mulad-al-Nabi")) 711 (holiday-islamic 3 12 "Mulad-al-Nabi"))
859 (if all-islamic-calendar-holidays 712 (if all-islamic-calendar-holidays
860 (islamic 7 26 "Shab-e-Mi'raj")) 713 (holiday-islamic 7 26 "Shab-e-Mi'raj"))
861 (if all-islamic-calendar-holidays 714 (if all-islamic-calendar-holidays
862 (islamic 8 15 "Shab-e-Bara't")) 715 (holiday-islamic 8 15 "Shab-e-Bara't"))
863 (islamic 9 1 "Ramadan Begins") 716 (holiday-islamic 9 1 "Ramadan Begins")
864 (if all-islamic-calendar-holidays 717 (if all-islamic-calendar-holidays
865 (islamic 9 27 "Shab-e Qadr")) 718 (holiday-islamic 9 27 "Shab-e Qadr"))
866 (if all-islamic-calendar-holidays 719 (if all-islamic-calendar-holidays
867 (islamic 10 1 "Id-al-Fitr")) 720 (holiday-islamic 10 1 "Id-al-Fitr"))
868 (if all-islamic-calendar-holidays 721 (if all-islamic-calendar-holidays
869 (islamic 12 10 "Id-al-Adha"))) 722 (holiday-islamic 12 10 "Id-al-Adha")))
870 "*Islamic holidays. 723 "*Islamic holidays.
871See the documentation for `calendar-holidays' for details.") 724See the documentation for `calendar-holidays' for details.")
872 725
@@ -874,18 +727,39 @@ See the documentation for `calendar-holidays' for details.")
874(defvar solar-holidays 727(defvar solar-holidays
875 '((if (fboundp 'atan) 728 '((if (fboundp 'atan)
876 (solar-equinoxes-solstices)) 729 (solar-equinoxes-solstices))
877 (sexp (eval calendar-daylight-savings-starts) 730 (progn
878 "Daylight Savings Time Begins") 731 (require 'cal-dst)
879 (sexp (eval calendar-daylight-savings-ends) 732 (funcall
880 "Daylight Savings Time Ends")) 733 'holiday-sexp
734 calendar-daylight-savings-starts
735 '(format "Daylight Savings Time Begins %s"
736 (if (fboundp 'atan)
737 (solar-time-string
738 (/ calendar-daylight-savings-switchover-time
739 (float 60))
740 date
741 'standard)
742 ""))))
743 (funcall
744 'holiday-sexp
745 calendar-daylight-savings-ends
746 '(format "Daylight Savings Time Ends %s"
747 (if (fboundp 'atan)
748 (solar-time-string
749 (/ (- calendar-daylight-savings-switchover-time
750 calendar-daylight-time-offset)
751 (float 60))
752 date
753 'daylight)
754 ""))))
881 "*Sun-related holidays. 755 "*Sun-related holidays.
882See the documentation for `calendar-holidays' for details.") 756See the documentation for `calendar-holidays' for details.")
883 757
884;;;###autoload 758;;;###autoload
885(defvar calendar-holidays 759(defvar calendar-holidays
886 '(append general-holidays local-holidays other-holidays 760 (append general-holidays local-holidays other-holidays
887 christian-holidays hebrew-holidays islamic-holidays 761 christian-holidays hebrew-holidays islamic-holidays
888 solar-holidays) 762 solar-holidays)
889 "*List of notable days for the command M-x holidays. 763 "*List of notable days for the command M-x holidays.
890 764
891Additional holidays are easy to add to the list, just put them in the list 765Additional holidays are easy to add to the list, just put them in the list
@@ -896,64 +770,66 @@ eliminate unwanted categories of holidays. The intention is that (in the US)
896`local-holidays' be set in site-init.el and `other-holidays' be set by the 770`local-holidays' be set in site-init.el and `other-holidays' be set by the
897user. 771user.
898 772
899The possible holiday-forms are as follows: 773Entries on the list are expressions that return (possibly empty) lists of
900 774items of the form ((month day year) string) of a holiday in the in the
901 (fixed MONTH DAY STRING) a fixed date on the Gregorian calendar 775three-month period centered around `displayed-month' of `displayed-year'.
902 (float MONTH DAYNAME K STRING) the Kth DAYNAME in MONTH on the Gregorian 776Several basic functions are provided for this purpose:
903 calendar (0 for Sunday, etc.); K<0 means 777
904 count back from the end of the month 778 (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar
905 (hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar 779 (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in
906 (islamic MONTH DAY STRING) a fixed date on the Islamic calendar 780 MONTH on the Gregorian calendar (0 for Sunday,
907 (julian MONTH DAY STRING) a fixed date on the Julian calendar 781 etc.); K<0 means count back from the end of the
908 (sexp SEXP STRING) SEXP is a Gregorian-date-valued expression 782 month. An optional parameter DAY means the Kth
783 DAYNAME after/before MONTH DAY.
784 (holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar
785 (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
786 (holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar
787 (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression
909 in the variable `year'; if it evaluates to 788 in the variable `year'; if it evaluates to
910 a visible date, that's the holiday; if it 789 a visible date, that's the holiday; if it
911 evaluates to nil, there's no holiday 790 evaluates to nil, there's no holiday. STRING
912 (if BOOLEAN HOLIDAY-FORM &optional HOLIDAY-FORM) gives a choice between 791 is an expression in the variable `date'.
913 two holidays based on the value of BOOLEAN
914 (FUNCTION &optional ARGS) dates requiring special computation; ARGS,
915 if any, are passed in a list to the function
916 `calendar-holiday-function-FUNCTION'
917 792
918For example, to add Bastille Day, celebrated in France on July 14, add 793For example, to add Bastille Day, celebrated in France on July 14, add
919 794
920 (fixed 7 14 \"Bastille Day\") 795 (holiday-fixed 7 14 \"Bastille Day\")
921 796
922to the list. To add Hurricane Supplication Day, celebrated in the Virgin 797to the list. To add Hurricane Supplication Day, celebrated in the Virgin
923Islands on the fourth Monday in August, add 798Islands on the fourth Monday in August, add
924 799
925 (float 8 1 4 \"Hurricane Supplication Day\") 800 (holiday-float 8 1 4 \"Hurricane Supplication Day\")
926 801
927to the list (the last Monday would be specified with `-1' instead of `4'). 802to the list (the last Monday would be specified with `-1' instead of `4').
928To add the last day of Hanukkah to the list, use 803To add the last day of Hanukkah to the list, use
929 804
930 (hebrew 10 2 \"Last day of Hanukkah\") 805 (holiday-hebrew 10 2 \"Last day of Hanukkah\")
931 806
932since the Hebrew months are numbered with 1 starting from Nisan, while to 807since the Hebrew months are numbered with 1 starting from Nisan, while to
933add the Islamic feast celebrating Mohammed's birthday use 808add the Islamic feast celebrating Mohammed's birthday use
934 809
935 (islamic 3 12 \"Mohammed's Birthday\") 810 (holiday-islamic 3 12 \"Mohammed's Birthday\")
936 811
937since the Islamic months are numbered from 1 starting with Muharram. To 812since the Islamic months are numbered from 1 starting with Muharram. To
938add Thomas Jefferson's birthday, April 2, 1743 (Julian), use 813add Thomas Jefferson's birthday, April 2, 1743 (Julian), use
939 814
940 (julian 4 2 \"Jefferson's Birthday\") 815 (holiday-julian 4 2 \"Jefferson's Birthday\")
941 816
942To include a holiday conditionally, use the if or the sexp form. For example, 817To include a holiday conditionally, use the sexp form or a conditional. For
943to include American presidential elections, which occur on the first Tuesday 818example, to include American presidential elections, which occur on the first
944after the first Monday in November of years divisible by 4, add 819Tuesday after the first Monday in November of years divisible by 4, add
945 820
946 (sexp (if (zerop (% year 4)) 821 (holiday-sexp
947 (calendar-gregorian-from-absolute 822 (if (zerop (% year 4))
948 (1+ (calendar-dayname-on-or-before 823 (calendar-gregorian-from-absolute
949 1 (+ 6 (calendar-absolute-from-gregorian 824 (1+ (calendar-dayname-on-or-before
950 (list 11 1 year))))))) 825 1 (+ 6 (calendar-absolute-from-gregorian
951 \"US Presidential Election\") 826 (list 11 1 year)))))))
827 \"US Presidential Election\")
952 828
953or 829or
954 830
955 (if (zerop (% displayed-year 4)) 831 (if (zerop (% displayed-year 4))
956 (fixed 11 832 (holiday-fixed 11
957 (extract-calendar-day 833 (extract-calendar-day
958 (calendar-gregorian-from-absolute 834 (calendar-gregorian-from-absolute
959 (1+ (calendar-dayname-on-or-before 835 (1+ (calendar-dayname-on-or-before
@@ -965,18 +841,11 @@ to the list. To include the phases of the moon, add
965 841
966 (lunar-phases) 842 (lunar-phases)
967 843
968to the holiday list, where `calendar-holiday-function-lunar-phases' is an 844to the holiday list, where `lunar-phases' is an Emacs-Lisp function that
969Emacs-Lisp function that you've written to return a (possibly empty) list of 845you've written to return a (possibly empty) list of the relevant VISIBLE dates
970the relevant VISIBLE dates with descriptive strings such as 846with descriptive strings such as
971
972 (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... )
973 847
974The fixed, float, hebrew, islamic, julian, sexp, and if forms are implemented 848 (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... ).")
975by the inclusion of the functions `calendar-holiday-function-fixed',
976`calendar-holiday-function-float', `calendar-holiday-function-hebrew',
977`calendar-holiday-function-islamic', `calendar-holiday-function-julian',
978`calendar-holiday-function-sexp', and `calendar-holiday-function-if',
979respectively.")
980 849
981(defconst calendar-buffer "*Calendar*" 850(defconst calendar-buffer "*Calendar*"
982 "Name of the buffer used for the calendar.") 851 "Name of the buffer used for the calendar.")
@@ -988,8 +857,8 @@ respectively.")
988 "Name of the buffer used for the optional fancy display of the diary.") 857 "Name of the buffer used for the optional fancy display of the diary.")
989 858
990(defmacro increment-calendar-month (mon yr n) 859(defmacro increment-calendar-month (mon yr n)
991 "Move the variables MON and YR to the month and year N months forward 860 "Move the variables MON and YR to the month and year by N months.
992if N is positive or backward if N is negative." 861Forward if N is positive or backward if N is negative."
993 (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) ))) 862 (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) )))
994 (setq (, mon) (1+ (% macro-y 12) )) 863 (setq (, mon) (1+ (% macro-y 12) ))
995 (setq (, yr) (/ macro-y 12))))) 864 (setq (, yr) (/ macro-y 12)))))
@@ -1001,8 +870,7 @@ if N is positive or backward if N is negative."
1001 (,@ body))))) 870 (,@ body)))))
1002 871
1003(defmacro calendar-sum (index initial condition expression) 872(defmacro calendar-sum (index initial condition expression)
1004 "For INDEX = INITIAL and successive integers, as long as CONDITION holds, 873 "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
1005sum EXPRESSION."
1006 (` (let (( (, index) (, initial)) 874 (` (let (( (, index) (, initial))
1007 (sum 0)) 875 (sum 0))
1008 (while (, condition) 876 (while (, condition)
@@ -1065,10 +933,25 @@ sum EXPRESSION."
1065 933
1066(defmacro calendar-leap-year-p (year) 934(defmacro calendar-leap-year-p (year)
1067 "Returns t if YEAR is a Gregorian leap year." 935 "Returns t if YEAR is a Gregorian leap year."
1068 (` (or 936 (` (and
1069 (and (= (% (, year) 4) 0) 937 (zerop (% (, year) 4))
1070 (/= (% (, year) 100) 0)) 938 (or (not (zerop (% (, year) 100)))
1071 (= (% (, year) 400) 0)))) 939 (zerop (% (, year) 400))))))
940;;(defun calendar-leap-year-p (year)
941;; "Returns t if YEAR is a Gregorian leap year."
942;; (and
943;; (zerop (% year 4))
944;; (or ((not (zerop (% year 100))))
945;; (zerop (% year 400)))))
946;;
947;; The foregoing is a bit faster, but not as clear as the following:
948;;
949;;(defmacro calendar-leap-year-p (year)
950;; "Returns t if YEAR is a Gregorian leap year."
951;; (` (or
952;; (and (= (% (, year) 4) 0)
953;; (/= (% (, year) 100) 0))
954;; (= (% (, year) 400) 0))))
1072;;(defun calendar-leap-year-p (year) 955;;(defun calendar-leap-year-p (year)
1073;; "Returns t if YEAR is a Gregorian leap year." 956;; "Returns t if YEAR is a Gregorian leap year."
1074;; (or 957;; (or
@@ -1125,9 +1008,7 @@ while (calendar-day-number '(12 31 1980)) returns 366."
1125(defmacro calendar-absolute-from-gregorian (date) 1008(defmacro calendar-absolute-from-gregorian (date)
1126 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. 1009 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
1127The Gregorian date Sunday, December 31, 1 BC is imaginary." 1010The Gregorian date Sunday, December 31, 1 BC is imaginary."
1128 (` (let ((month (, (macroexpand (` (extract-calendar-month (, date)))))) 1011 (` (let ((year (, (macroexpand (` (extract-calendar-year (, date)))))))
1129 (day (, (macroexpand (` (extract-calendar-day (, date))))))
1130 (year (, (macroexpand (` (extract-calendar-year (, date)))))))
1131 (+ (, (macroexpand (` (calendar-day-number (, date)))));; Days this year 1012 (+ (, (macroexpand (` (calendar-day-number (, date)))));; Days this year
1132 (* 365 (1- year));; + Days in prior years 1013 (* 365 (1- year));; + Days in prior years
1133 (/ (1- year) 4);; + Julian leap years 1014 (/ (1- year) 4);; + Julian leap years
@@ -1136,9 +1017,7 @@ The Gregorian date Sunday, December 31, 1 BC is imaginary."
1136;;(defun calendar-absolute-from-gregorian (date) 1017;;(defun calendar-absolute-from-gregorian (date)
1137;; "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. 1018;; "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
1138;;The Gregorian date Sunday, December 31, 1 BC is imaginary." 1019;;The Gregorian date Sunday, December 31, 1 BC is imaginary."
1139;; (let ((month (extract-calendar-month date)) 1020;; (let ((year (extract-calendar-year date)))
1140;; (day (extract-calendar-day date))
1141;; (year (extract-calendar-year date)))
1142;; (+ (calendar-day-number date);; Days this year 1021;; (+ (calendar-day-number date);; Days this year
1143;; (* 365 (1- year));; + Days in prior years 1022;; (* 365 (1- year));; + Days in prior years
1144;; (/ (1- year) 4);; + Julian leap years 1023;; (/ (1- year) 4);; + Julian leap years
@@ -1308,6 +1187,7 @@ Each entry in diary-file visible in the calendar window is marked."
1308 "Insert a weekly diary entry for the day of the week indicated by point." 1187 "Insert a weekly diary entry for the day of the week indicated by point."
1309 t) 1188 t)
1310 1189
1190
1311(autoload 'insert-monthly-diary-entry "diary-ins" 1191(autoload 'insert-monthly-diary-entry "diary-ins"
1312 "Insert a monthly diary entry for the day of the month indicated by point." 1192 "Insert a monthly diary entry for the day of the month indicated by point."
1313 t) 1193 t)
@@ -1470,6 +1350,9 @@ the inserted text. Value is always t."
1470 (generate-calendar-window displayed-month displayed-year) 1350 (generate-calendar-window displayed-month displayed-year)
1471 (calendar-cursor-to-visible-date cursor-date))) 1351 (calendar-cursor-to-visible-date cursor-date)))
1472 1352
1353(defvar calendar-debug-sexp nil
1354 "*Turn debugging on when evaluating a sexp in the diary or holiday list.")
1355
1473(defvar calendar-mode-map nil) 1356(defvar calendar-mode-map nil)
1474(if calendar-mode-map 1357(if calendar-mode-map
1475 nil 1358 nil
@@ -1822,10 +1705,10 @@ The Gregorian calendar is assumed."
1822 (make-local-variable 'displayed-year));; Year in middle of window. 1705 (make-local-variable 'displayed-year));; Year in middle of window.
1823 1706
1824(defun calendar-string-spread (strings char length) 1707(defun calendar-string-spread (strings char length)
1825 "A list of STRINGS is concatenated separated by copies of CHAR so that it 1708 "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH
1826fills LENGTH; there must be at least 2 strings. The effect is like mapconcat 1709There must be at least 2 strings. The effect is like mapconcat but the
1827but the separating pieces are as balanced as possible. Each item of STRINGS 1710separating pieces are as balanced as possible. Each item of STRINGS is
1828is evaluated before concatenation so it can actually be an expression that 1711evaluated before concatenation so it can actually be an expression that
1829evaluates to a string. If LENGTH is too short, the STRINGS are just 1712evaluates to a string. If LENGTH is too short, the STRINGS are just
1830concatenated and the result truncated." 1713concatenated and the result truncated."
1831;; The algorithm is based on equation (3.25) on page 85 of Concrete 1714;; The algorithm is based on equation (3.25) on page 85 of Concrete
@@ -2153,26 +2036,57 @@ Moves forward if ARG is negative."
2153 (calendar-other-month 12 (- year (1- arg))) 2036 (calendar-other-month 12 (- year (1- arg)))
2154 (calendar-cursor-to-visible-date (list 12 31 displayed-year)))))) 2037 (calendar-cursor-to-visible-date (list 12 31 displayed-year))))))
2155 2038
2039;; The following version of calendar-gregorian-from-absolute is preferred for
2040;; reasons of clarity, BUT it's much slower than the version that follows it.
2041
2042;;(defun calendar-gregorian-from-absolute (date)
2043;; "Compute the list (month day year) corresponding to the absolute DATE.
2044;;The absolute date is the number of days elapsed since the (imaginary)
2045;;Gregorian date Sunday, December 31, 1 BC."
2046;; (let* ((approx (/ date 366));; Approximation from below.
2047;; (year ;; Search forward from the approximation.
2048;; (+ approx
2049;; (calendar-sum y approx
2050;; (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
2051;; 1)))
2052;; (month ;; Search forward from January.
2053;; (1+ (calendar-sum m 1
2054;; (> date
2055;; (calendar-absolute-from-gregorian
2056;; (list m (calendar-last-day-of-month m year) year)))
2057;; 1)))
2058;; (day ;; Calculate the day by subtraction.
2059;; (- date
2060;; (1- (calendar-absolute-from-gregorian (list month 1 year))))))
2061;; (list month day year)))
2062
2156(defun calendar-gregorian-from-absolute (date) 2063(defun calendar-gregorian-from-absolute (date)
2157 "Compute the list (month day year) corresponding to the absolute DATE. 2064 "Compute the list (month day year) corresponding to the absolute DATE.
2158The absolute date is the number of days elapsed since the (imaginary) 2065The absolute date is the number of days elapsed since the (imaginary)
2159Gregorian date Sunday, December 31, 1 BC." 2066Gregorian date Sunday, December 31, 1 BC."
2160 (let* ((approx (/ date 366));; Approximation from below. 2067;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
2161 (year ;; Search forward from the approximation. 2068;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M.
2162 (+ approx 2069;; Clamen, Software--Practice and Experience, Volume 23, Number 4
2163 (calendar-sum y approx 2070;; (April, 1993), pages 383-404 for an explanation.
2164 (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y)))) 2071 (let* ((d0 (1- date))
2165 1))) 2072 (n400 (/ d0 146097))
2166 (month ;; Search forward from January. 2073 (d1 (% d0 146097))
2167 (1+ (calendar-sum m 1 2074 (n100 (/ d1 36524))
2168 (> date 2075 (d2 (% d1 36524))
2169 (calendar-absolute-from-gregorian 2076 (n4 (/ d2 1461))
2170 (list m (calendar-last-day-of-month m year) year))) 2077 (d3 (% d2 1461))
2171 1))) 2078 (n1 (/ d3 365))
2172 (day ;; Calculate the day by subtraction. 2079 (day (1+ (% d3 365)))
2173 (- date 2080 (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1)))
2174 (1- (calendar-absolute-from-gregorian (list month 1 year)))))) 2081 (if (or (= n100 4) (= n1 4))
2175 (list month day year))) 2082 (list 12 31 year)
2083 (let ((year (1+ year))
2084 (month 1))
2085 (while (let ((mdays (calendar-last-day-of-month month year)))
2086 (and (< mdays day)
2087 (setq day (- day mdays))))
2088 (setq month (1+ month)))
2089 (list month day year)))))
2176 2090
2177(defun calendar-cursor-to-visible-date (date) 2091(defun calendar-cursor-to-visible-date (date)
2178 "Move the cursor to DATE that is on the screen." 2092 "Move the cursor to DATE that is on the screen."
@@ -2617,21 +2531,27 @@ absolute date d, applying it to d-1 gives the DAYNAME previous to absolute
2617date d, and applying it to d+7 gives the DAYNAME following absolute date d." 2531date d, and applying it to d+7 gives the DAYNAME following absolute date d."
2618 (- date (% (- date dayname) 7))) 2532 (- date (% (- date dayname) 7)))
2619 2533
2620(defun calendar-nth-named-day (n dayname month year) 2534(defun calendar-nth-named-day (n dayname month year &optional day)
2621 "Returns the date of the Nth DAYNAME in MONTH, YEAR. 2535 "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
2622A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0, the 2536A DAYNAME of 0 means Sunday, 1 means Monday, and so on. If N<0,
2623date returned is the Nth DAYNAME from the end of MONTH, YEAR (that is, -1 is 2537return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
2624the last DAYNAME, -2 is the penultimate DAYNAME, and so on." 2538If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
2539
2540If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
2625 (calendar-gregorian-from-absolute 2541 (calendar-gregorian-from-absolute
2626 (if (> n 0) 2542 (if (> n 0)
2627 (+ (calendar-dayname-on-or-before 2543 (+ (* 7 (1- n))
2628 dayname (calendar-absolute-from-gregorian (list month 7 year))) 2544 (calendar-dayname-on-or-before
2629 (* 7 (1- n))) 2545 dayname
2630 (+ (calendar-dayname-on-or-before 2546 (+ 6 (calendar-absolute-from-gregorian
2631 dayname 2547 (list month (or day 1) year)))))
2632 (calendar-absolute-from-gregorian 2548 (+ (* 7 (1+ n))
2633 (list month (calendar-last-day-of-month month year) year))) 2549 (calendar-dayname-on-or-before
2634 (* 7 (1+ n)))))) 2550 dayname
2551 (calendar-absolute-from-gregorian
2552 (list month
2553 (or day (calendar-last-day-of-month month year))
2554 year)))))))
2635 2555
2636(defun calendar-print-day-of-year () 2556(defun calendar-print-day-of-year ()
2637 "Show the day number in the year and the number of days remaining in the 2557 "Show the day number in the year and the number of days remaining in the
@@ -2646,8 +2566,8 @@ year for the date under the cursor."
2646 day year days-remaining (if (= days-remaining 1) "" "s")))) 2566 day year days-remaining (if (= days-remaining 1) "" "s"))))
2647 2567
2648(defun calendar-absolute-from-iso (date) 2568(defun calendar-absolute-from-iso (date)
2649 "The number of days elapsed between the Gregorian date 12/31/1 BC and 2569 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
2650DATE. The `ISO year' corresponds approximately to the Gregorian year, but 2570The `ISO year' corresponds approximately to the Gregorian year, but
2651weeks start on Monday and end on Sunday. The first week of the ISO year is 2571weeks start on Monday and end on Sunday. The first week of the ISO year is
2652the first such week in which at least 4 days are in a year. The ISO 2572the first such week in which at least 4 days are in a year. The ISO
2653commercial DATE has the form (week day year) in which week is in the range 2573commercial DATE has the form (week day year) in which week is in the range
@@ -2682,8 +2602,7 @@ date Sunday, December 31, 1 BC."
2682 year))) 2602 year)))
2683 2603
2684(defun calendar-print-iso-date () 2604(defun calendar-print-iso-date ()
2685 "Show the equivalent date on the `ISO commercial calendar' for the date 2605 "Show equivalent ISO date for the date under the cursor."
2686under the cursor."
2687 (interactive) 2606 (interactive)
2688 (let* ((greg-date 2607 (let* ((greg-date
2689 (or (calendar-cursor-to-date) 2608 (or (calendar-cursor-to-date)
@@ -2872,8 +2791,7 @@ Gregorian date Sunday, December 31, 1 BC."
2872 30)) 2791 30))
2873 2792
2874(defun hebrew-calendar-elapsed-days (year) 2793(defun hebrew-calendar-elapsed-days (year)
2875 "Number of days elapsed from the Sunday prior to the start of the Hebrew 2794 "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
2876calendar to the mean conjunction of Tishri of Hebrew YEAR."
2877 (let* ((months-elapsed 2795 (let* ((months-elapsed
2878 (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far. 2796 (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
2879 (* 12 (% (1- year) 19)) ;; Regular months in this cycle 2797 (* 12 (% (1- year) 19)) ;; Regular months in this cycle
@@ -3006,9 +2924,9 @@ Gregorian date Sunday, December 31, 1 BC."
3006 2924
3007;;;###autoload 2925;;;###autoload
3008(defun list-yahrzeit-dates (death-date start-year end-year) 2926(defun list-yahrzeit-dates (death-date start-year end-year)
3009 "List of Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to 2927 "List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
3010END-YEAR. When called interactively from the calendar window, 2928When called interactively from the calendar window, the date of death is taken
3011the date of death is taken from the cursor position." 2929from the cursor position."
3012 (interactive 2930 (interactive
3013 (let* ((death-date 2931 (let* ((death-date
3014 (if (equal (current-buffer) (get-buffer calendar-buffer)) 2932 (if (equal (current-buffer) (get-buffer calendar-buffer))
@@ -3079,8 +2997,7 @@ the date of death is taken from the cursor position."
3079 (message "Computing yahrzeits...done"))) 2997 (message "Computing yahrzeits...done")))
3080 2998
3081(defun calendar-print-astro-day-number () 2999(defun calendar-print-astro-day-number ()
3082 "Show the astronomical (Julian) day number of afternoon on date 3000 "Show astronomical (Julian) day number of afternoon on date shown by cursor."
3083shown by cursor."
3084 (interactive) 3001 (interactive)
3085 (message 3002 (message
3086 "Astronomical (Julian) day number after noon UTC: %d" 3003 "Astronomical (Julian) day number after noon UTC: %d"