(diary-float): Rewritten to fix bug when base date

of entry and entry date are in different months.
Added optional parameter DAY.
(list-sexp-diary-entries): Revise description of diary-float.

1 files changed, 57 insertions, 12 deletions

diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 1046296bcaf..70a03fa26d7 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -940,12 +940,14 @@ A number of built-in functions are available for this type of diary entry:
                   can be lists of integers, the constant t, or an integer.
                   The constant t means all values.
 
-      %%(diary-float MONTH DAYNAME N) text
+      %%(diary-float MONTH DAYNAME N &optional DAY) text
                   Entry will appear on the Nth DAYNAME of MONTH.
                   (DAYNAME=0 means Sunday, 1 means Monday, and so on;
                   if N is negative it counts backward from the end of
                   the month.  MONTH can be a list of months, a single
-                  month, or t to specify all months.
+                  month, or t to specify all months. Optional DAY means
+                  Nth DAYNAME of MONTH on or after/before DAY.  DAY defaults
+                  to 1 if N>0 and the last day of the month if N<0.
 
       %%(diary-block M1 D1 Y1 M2 D2 Y2) text
                   Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
@@ -1166,19 +1168,62 @@ D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t."
     (if (and (<= date1 d) (<= d date2))
         entry)))
 
-(defun diary-float (month dayname n)
+(defun diary-float (month dayname n &optional day)
   "Floating diary entry--entry applies if date is the nth dayname of month.
 Parameters are MONTH, DAYNAME, N.  MONTH can be a list of months, the constant
 t, or an integer.  The constant t means all months.  If N is negative, count
-backward from the end of the month."
-  (let ((m (extract-calendar-month date))
-        (y (extract-calendar-year date)))
-    (if (and
-         (or (and (listp month) (memq m month))
-             (equal m month)
-             (eq month t))
-         (calendar-date-equal date (calendar-nth-named-day n dayname m y)))
-        entry)))
+backward from the end of the month.
+
+An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY."
+;; This is messy because the diary entry may apply, but the date on which it
+;; is based can be in a different month/year.  For example, asking for the
+;; first Monday after December 30.  For large values of |n| the problem is
+;; more grotesque.
+  (and (= dayname (calendar-day-of-week date))
+       (let* ((m (extract-calendar-month date))
+              (d (extract-calendar-day date))
+              (y (extract-calendar-year date))
+              (limit; last (n>0) or first (n<0) possible base date for entry
+               (calendar-nth-named-absday (- n) dayname m y d))
+              (last-abs (if (> n 0) limit (+ limit 6)))
+              (first-abs (if (> n 0) (- limit 6) limit))
+              (last (calendar-gregorian-from-absolute last-abs))
+              (first (calendar-gregorian-from-absolute first-abs))
+              ; m1, d1 is first possible base date
+              (m1 (extract-calendar-month first))
+              (d1 (extract-calendar-day first))
+              (y1 (extract-calendar-year first))
+              ; m2, d2 is last possible base date
+              (m2 (extract-calendar-month last))
+              (d2 (extract-calendar-day last))
+              (y2 (extract-calendar-year last)))
+         (or (and (= m1 m2); only possible base dates in one month
+                  (or (and (listp month) (memq m1 month))
+                      (= m1 month)
+                      (eq month t))
+                  (let ((d (or day (if (> n 0)
+                                       1
+                                     (calendar-last-day-of-month m1 y1)))))
+                    (and (<= d1 day) (<= day d2))))
+             (and (< m1 m2); only possible base dates straddle two months
+                  (or
+                   ; m1, d1 works is a base date
+                   (and
+                    (or (and (listp month) (memq m1 month))
+                        (= m1 month)
+                        (eq month t))
+                    (<= d1 (or day (if (> n 0)
+                                       1
+                                     (calendar-last-day-of-month m1 y1)))))
+                   ; m2, d2 works is a base date
+                   (and (or (and (listp month) (memq m2 month))
+                            (= m2 month)
+                            (eq month t))
+                        (<= (or day (if (> n 0)
+                                        1
+                                      (calendar-last-day-of-month m2 y2)))
+                            d2)))))
+         entry)))
 
 (defun diary-anniversary (month day year)
   "Anniversary diary entry.