[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/03 04:09:31

Index: holidays.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calendar/holidays.el,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -b -r1.70 -r1.71
--- holidays.el 1 Apr 2008 02:47:40 -0000       1.70
+++ holidays.el 3 Apr 2008 04:09:31 -0000       1.71
@@ -39,19 +39,19 @@
 (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'."
-  (sort (delq nil
-              (mapcar (lambda (p)
-                        (car
-                         (if calendar-debug-sexp
+  (let (res h)
+    (sort
+     (dolist (p calendar-holidays res)
+       (if (setq h (if calendar-debug-sexp
                              (let ((stack-trace-on-error t))
                                (eval p))
                            (condition-case nil
                                (eval p)
                              (error (beep)
                                     (message "Bad holiday list item: %s" p)
-                                    (sleep-for 2))))))
-                      calendar-holidays))
-        'calendar-date-compare))
+                              (sleep-for 2)))))
+           (setq res (append h res))))
+     'calendar-date-compare)))
 
 (defvar displayed-month)                ; from generate-calendar
 (defvar displayed-year)
@@ -322,13 +322,12 @@
          (list (list (calendar-nth-named-day n dayname month y d)
                      string)))))
 
-(defun holiday-filter-visible-calendar (l)
-  "Return a list of all visible holidays of those on L."
-  (let (visible)
-    (dolist (p l visible)
-      (and (car p)
-           (calendar-date-is-visible-p (car p))
-           (push p visible)))))
+(defun holiday-filter-visible-calendar (hlist)
+  "Filter list of holidays HLIST, and return only the visible ones.
+HLIST is a list of elements of the form (DATE) TEXT."
+  (delq nil (mapcar (lambda (p)
+                      (and (car p) (calendar-date-is-visible-p (car p)) p))
+                    hlist)))
 
 (define-obsolete-function-alias
   'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1")
@@ -394,9 +393,10 @@
 is non-nil)."
   ;; Backwards compatibility layer.
   (if (not n)
-      (delq nil                   ; filter out nil (not visible) dates
+      (apply 'append
             (mapcar (lambda (e)
                       (apply 'holiday-easter-etc e))
+                     ;; The combined list is not in order.
                     (append
                      (if all-christian-calendar-holidays
                          '((-63 "Septuagesima Sunday")
@@ -413,9 +413,9 @@
                            (50 "Whitmonday")
                            (56 "Trinity Sunday")
                            (60 "Corpus Christi")))
-                     '((0 "Easter Sunday")
+                      '((-46 "Ash Wednesday")
                        (-2 "Good Friday")
-                       (-46 "Ash Wednesday")))))
+                        (0 "Easter Sunday")))))
     (let* ((century (1+ (/ displayed-year 100)))
            (shifted-epact               ; age of moon for April 5...
             (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule
@@ -433,10 +433,10 @@
            (paschal-moon ; day after the full moon on or after March 21
             (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
                adjusted-epact))
-           (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))))
-      (holiday-filter-visible-calendar
-       (list (list (calendar-gregorian-from-absolute (+ abs-easter n))
-                   string))))))
+           (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
+           (greg (calendar-gregorian-from-absolute (+ abs-easter n))))
+      (if (calendar-date-is-visible-p greg)
+          (list (list greg string))))))
 
 ;; Prior call to calendar-julian-from-absolute will autoload cal-julian.
 (declare-function calendar-absolute-from-julian "cal-julian" (date))