[Emacs-diffs] Changes to emacs/lisp/calendar/holidays.el,v

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       08/04/01 02:47:40

Index: holidays.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calendar/holidays.el,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -b -r1.69 -r1.70
--- holidays.el 31 Mar 2008 01:35:11 -0000      1.69
+++ holidays.el 1 Apr 2008 02:47:40 -0000       1.70
@@ -26,24 +26,7 @@
 
 ;;; Commentary:
 
-;; This collection of functions implements the holiday features as described
-;; in calendar.el.
-
-;; Technical details of all the calendrical calculations can be found in
-;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
-;; and Nachum Dershowitz, Cambridge University Press (2001).
-
-;; An earlier version of the technical details appeared in
-;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
-;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
-;; pages 899-928.  ``Calendrical Calculations, Part II: Three Historical
-;; Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M. Clamen,
-;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
-;; pages 383-404.
-
-;; Hard copies of these two papers can be obtained by sending email to
-;; address@hidden with the SUBJECT "send-paper-cal" (no quotes) and
-;; the message BODY containing your mailing address (snail).
+;; See calendar.el.
 
 ;;; Code:
 
@@ -56,9 +39,9 @@
 (defun calendar-holiday-list ()
   "Form the list of holidays that occur on dates in the calendar window.
 The holidays are those in the list `calendar-holidays'."
-  (let (holiday-list)
-    (dolist (p calendar-holidays)
-      (let* ((holidays
+  (sort (delq nil
+              (mapcar (lambda (p)
+                        (car
               (if calendar-debug-sexp
                   (let ((stack-trace-on-error t))
                     (eval p))
@@ -67,9 +50,8 @@
                   (error (beep)
                          (message "Bad holiday list item: %s" p)
                          (sleep-for 2))))))
-        (if holidays
-            (setq holiday-list (append holidays holiday-list)))))
-    (setq holiday-list (sort holiday-list 'calendar-date-compare))))
+                      calendar-holidays))
+        'calendar-date-compare))
 
 (defvar displayed-month)                ; from generate-calendar
 (defvar displayed-year)
@@ -77,8 +59,8 @@
 ;;;###cal-autoload
 (defun calendar-list-holidays ()
   "Create a buffer containing the holidays for the current calendar window.
-The holidays are those in the list `calendar-notable-days'.  Returns t if any
-holidays are found, otherwise nil."
+The holidays are those in the list `calendar-notable-days'.
+Returns non-nil if any holidays are found."
   (interactive)
   (message "Looking up holidays...")
   (let ((holiday-list (calendar-holiday-list))
@@ -87,9 +69,7 @@
         (m2 displayed-month)
         (y2 displayed-year))
     (if (not holiday-list)
-        (progn
           (message "Looking up holidays...none found")
-          nil)
       (calendar-in-read-only-buffer holiday-buffer
         (increment-calendar-month m1 y1 -1)
         (increment-calendar-month m2 y2 1)
@@ -104,8 +84,8 @@
           (lambda (x) (concat (calendar-date-string (car x))
                               ": " (cadr x)))
           holiday-list "\n")))
-      (message "Looking up holidays...done")
-      t)))
+      (message "Looking up holidays...done"))
+    holiday-list))
 
 (define-obsolete-function-alias
   'list-calendar-holidays 'calendar-list-holidays "23.1")
@@ -186,20 +166,17 @@
      (list start-year end-year which name)))
   (unless y2 (setq y2 y1))
   (message "Computing holidays...")
-  (let* ((calendar-holidays (or l calendar-holidays))
+  (let ((calendar-holidays (or l calendar-holidays))
          (title (or label "Holidays"))
-         (holiday-list nil)
          (s (calendar-absolute-from-gregorian (list 2 1 y1)))
          (e (calendar-absolute-from-gregorian (list 11 1 y2)))
-         (d s)
-         (never t)
          (displayed-month 2)
-         (displayed-year y1))
-    (while (or never (<= d e))
-      (setq holiday-list (append holiday-list (calendar-holiday-list))
-            never nil)
+        (displayed-year y1)
+        holiday-list)
+    (while (<= s e)
+      (setq holiday-list (append holiday-list (calendar-holiday-list)))
       (increment-calendar-month displayed-month displayed-year 3)
-      (setq d (calendar-absolute-from-gregorian
+      (setq s (calendar-absolute-from-gregorian
                (list displayed-month 1 displayed-year))))
     (save-excursion
       (calendar-in-read-only-buffer holiday-buffer
@@ -224,11 +201,10 @@
 The holidays are those in the list `calendar-holidays'."
   (let ((displayed-month (extract-calendar-month date))
         (displayed-year (extract-calendar-year date))
-        (holiday-list))
-    (dolist (h (calendar-holiday-list))
+        holiday-list)
+    (dolist (h (calendar-holiday-list) holiday-list)
       (if (calendar-date-equal date (car h))
-          (setq holiday-list (append holiday-list (cdr h)))))
-    holiday-list))
+          (setq holiday-list (append holiday-list (cdr h)))))))
 
 (define-obsolete-function-alias
   'check-calendar-holidays 'calendar-check-holidays "23.1")
@@ -304,33 +280,32 @@
 An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
 
 Returns nil if it is not visible in the current calendar window."
-  ;; This is messy because the holiday may be visible, while the date on which
-  ;; it is based is not.  For example, the first Monday after December 30 may 
be
-  ;; visible when January is not.  For large values of |n| the problem is more
-  ;; grotesque.  If we didn't have to worry about such cases, we could just use
-
+  ;; This is messy because the holiday may be visible, while the date
+  ;; on which it is based is not.  For example, the first Monday after
+  ;; December 30 may be visible when January is not.  For large values
+  ;; of |n| the problem is more grotesque.  If we didn't have to worry
+  ;; about such cases, we could just use the original version of this
+  ;; function:
   ;;  (let ((m displayed-month)
   ;;        (y displayed-year))
   ;;    (increment-calendar-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)))))
-
-  ;; which is the way the function was originally written.
-
   (let* ((m1 displayed-month)
          (y1 displayed-year)
-         (m2 m1)
-         (y2 y1))
+         (m2 displayed-month)
+         (y2 displayed-year)
+         (d1 (progn             ; first possible base date for holiday
     (increment-calendar-month m1 y1 -1)
-    (increment-calendar-month m2 y2 1)
-    (let* ((d1                 ; first possible base date for holiday
             (+ (calendar-nth-named-absday 1 dayname m1 y1)
                (* -7 n)
-               (if (> n 0) 1 -7)))
+                  (if (> n 0) 1 -7))))
            (d2                  ; last possible base date for holiday
+          (progn
+            (increment-calendar-month m2 y2 1)
             (+ (calendar-nth-named-absday -1 dayname m2 y2)
                (* -7 n)
-               (if (> n 0) 7 -1)))
+               (if (> n 0) 7 -1))))
            (y1 (extract-calendar-year (calendar-gregorian-from-absolute d1)))
            (y2 (extract-calendar-year (calendar-gregorian-from-absolute d2)))
            (y                           ; year of base date
@@ -343,9 +318,9 @@
                       (calendar-last-day-of-month month y))))
            (date                        ; base date for holiday
             (calendar-absolute-from-gregorian (list month d y))))
-      (if (and (<= d1 date) (<= date d2))
+    (and (<= d1 date) (<= date d2)
           (list (list (calendar-nth-named-day n dayname month y d)
-                      string))))))
+                     string)))))
 
 (defun holiday-filter-visible-calendar (l)
   "Return a list of all visible holidays of those on L."
@@ -360,26 +335,26 @@
 
 (defun holiday-sexp (sexp string)
   "Sexp holiday for dates in the calendar window.
-SEXP is an expression in variable `year' evaluates to `date'.
-
-STRING is an expression in `date' that evaluates to the holiday description
-of `date'.
-
-If `date' is visible in the calendar window, the holiday STRING is on that
-date.  If date is nil, or if the date is not visible, there is no holiday."
+SEXP is an expression in variable `year' that is evaluated to
+give `date'.  STRING is an expression in `date' that evaluates to
+the holiday description of `date'.  If `date' is visible in the
+calendar window, the holiday STRING is on that date.  If date is
+nil, or if the date is not visible, there is no holiday."
   (let ((m displayed-month)
-        (y displayed-year))
+        (y displayed-year)
+        year date)
     (increment-calendar-month m y -1)
     (holiday-filter-visible-calendar
      (list
-      (let* ((year y)
-             (date (eval sexp))
-             (string (if date (eval string))))
-        (list date string))
-      (let* ((year (1+ y))
-             (date (eval sexp))
-             (string (if date (eval string))))
-        (list date string))))))
+      (progn
+        (setq year y
+              date (eval sexp))
+        (list date (if date (eval string))))
+      (progn
+        (setq year (1+ y)
+              date (eval sexp))
+        (list date (if date (eval string))))))))
+
 
 (defun holiday-advent (&optional n string)
   "Date of Nth day after advent (named STRING), if visible in calendar window.
@@ -393,17 +368,18 @@
   ;; Backwards compatibility layer.
   (if (not n)
       (holiday-advent 0 "Advent")
-    (let ((year displayed-year)
-          (month displayed-month))
+    (let* ((year displayed-year)
+           (month displayed-month)
+           (advent (progn
       (increment-calendar-month month year -1)
-      (let ((advent (calendar-gregorian-from-absolute
+                     (calendar-gregorian-from-absolute
                      (+ n
                         (calendar-dayname-on-or-before
                          0
                          (calendar-absolute-from-gregorian
-                          (list 12 3 year)))))))
+                           (list 12 3 year))))))))
         (if (calendar-date-is-visible-p advent)
-            (list (list advent string)))))))
+          (list (list advent string))))))
 
 (defun holiday-easter-etc (&optional n string)
   "Date of Nth day after Easter (named STRING), if visible in calendar window.
@@ -418,30 +394,28 @@
 is non-nil)."
   ;; Backwards compatibility layer.
   (if (not n)
-      (let (res-list res)
-        (dolist (elem (append
+      (delq nil                   ; filter out nil (not visible) dates
+            (mapcar (lambda (e)
+                      (apply 'holiday-easter-etc e))
+                    (append
                        (if all-christian-calendar-holidays
-                           '((-63 . "Septuagesima Sunday")
-                             (-56 . "Sexagesima Sunday")
-                             (-49 . "Shrove Sunday")
-                             (-48 . "Shrove Monday")
-                             (-47 . "Shrove Tuesday")
-                             (-14 . "Passion Sunday")
-                             (-7 . "Palm Sunday")
-                             (-3 . "Maundy Thursday")
-                             (35 . "Rogation Sunday")
-                             (39 . "Ascension Day")
-                             (49 . "Pentecost (Whitsunday)")
-                             (50 . "Whitmonday")
-                             (56 . "Trinity Sunday")
-                             (60 . "Corpus Christi")))
-                       '((0 . "Easter Sunday")
-                         (-2 . "Good Friday")
-                         (-46 . "Ash Wednesday")))
-                      res-list)
-          ;; Filter out nil (not visible) values.
-          (if (setq res (holiday-easter-etc (car elem) (cdr elem)))
-              (setq res-list (append res res-list)))))
+                         '((-63 "Septuagesima Sunday")
+                           (-56 "Sexagesima Sunday")
+                           (-49 "Shrove Sunday")
+                           (-48 "Shrove Monday")
+                           (-47 "Shrove Tuesday")
+                           (-14 "Passion Sunday")
+                           (-7 "Palm Sunday")
+                           (-3 "Maundy Thursday")
+                           (35 "Rogation Sunday")
+                           (39 "Ascension Day")
+                           (49 "Pentecost (Whitsunday)")
+                           (50 "Whitmonday")
+                           (56 "Trinity Sunday")
+                           (60 "Corpus Christi")))
+                     '((0 "Easter Sunday")
+                       (-2 "Good Friday")
+                       (-46 "Ash Wednesday")))))
     (let* ((century (1+ (/ displayed-year 100)))
            (shifted-epact               ; age of moon for April 5...
             (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule
@@ -469,14 +443,14 @@
 
 (defun holiday-greek-orthodox-easter ()
   "Date of Easter according to the rule of the Council of Nicaea."
-  (let ((m displayed-month)
-        (y displayed-year))
+  (let* ((m displayed-month)
+         (y displayed-year)
+         (julian-year (progn
     (increment-calendar-month m y 1)
-    (let* ((julian-year
             (extract-calendar-year
              (calendar-julian-from-absolute
               (calendar-absolute-from-gregorian
-               (list m (calendar-last-day-of-month m y) y)))))
+                           (list m (calendar-last-day-of-month m y) y))))))
            (shifted-epact               ; age of moon for April 5
             (% (+ 14
                   (* 11 (% julian-year 19)))
@@ -488,7 +462,7 @@
             (calendar-gregorian-from-absolute
              (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))))
       (if (calendar-date-is-visible-p nicaean-easter)
-          (list (list nicaean-easter "Pascha (Greek Orthodox Easter)"))))))
+        (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))
 
 (provide 'holidays)