Function: diary-float

diary-float is a byte-compiled function defined in diary-lib.el.gz.

Signature

(diary-float MONTH DAYNAME N &optional DAY MARK)

Documentation

Diary entry for the Nth DAYNAME after/before MONTH DAY.

DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on. If N>0, use the Nth DAYNAME after MONTH DAY. If N<0, use the Nth DAYNAME before MONTH DAY. DAY defaults to 1 if N>0, and MONTH's last day otherwise. MONTH can be a list of months, an integer, or t (meaning all months). Optional MARK specifies a face or single-character string to use when highlighting the day in the calendar.

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/diary-lib.el.gz
;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
(defun diary-float (month dayname n &optional day mark)
  "Diary entry for the Nth DAYNAME after/before MONTH DAY.
DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
If N>0, use the Nth DAYNAME after MONTH DAY.
If N<0, use the Nth DAYNAME before MONTH DAY.
DAY defaults to 1 if N>0, and MONTH's last day otherwise.
MONTH can be a list of months, an integer, or t (meaning all months).
Optional MARK specifies a face or single-character string to use when
highlighting the day in the calendar."
  (with-no-warnings (defvar date) (defvar entry))
  ;; 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 (calendar-extract-month date))
              (d (calendar-extract-day date))
              (y (calendar-extract-year date))
              ;; Last (n>0) or first (n<0) possible base date for entry.
              (limit
               (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 (calendar-extract-month first))
              (d1 (calendar-extract-day first))
              (y1 (calendar-extract-year first))
              ;; m2, d2 is last possible base date.
              (m2 (calendar-extract-month last))
              (d2 (calendar-extract-day last))
              (y2 (calendar-extract-year last)))
         (if (or (and (= m1 m2) ; only possible base dates in one month
                      (or (eq month t)
                          (if (listp month)
                              (memq m1 month)
                            (= m1 month)))
                      (let ((d (or day (if (> n 0)
                                           1
                                         (calendar-last-day-of-month m1 y1)))))
                        (and (<= d1 d) (<= d d2))))
                 ;; Only possible base dates straddle two months.
                 (and (or (< y1 y2)
                          (and (= y1 y2) (< m1 m2)))
                      (or
                       ;; m1, d1 works as a base date.
                       (and
                        (or (eq month t)
                            (if (listp month)
                                (memq m1 month)
                              (= m1 month)))
                        (<= d1 (or day (if (> n 0)
                                           1
                                         (calendar-last-day-of-month m1 y1)))))
                       ;; m2, d2 works as a base date.
                       (and (or (eq month t)
                                (if (listp month)
                                    (memq m2 month)
                                  (= m2 month)))
                            (<= (or day (if (> n 0)
                                            1
                                          (calendar-last-day-of-month m2 y2)))
                                d2)))))
             (cons mark entry)))))