Function: nndiary-next-occurrence

nndiary-next-occurrence is a byte-compiled function defined in nndiary.el.gz.

Signature

(nndiary-next-occurrence SCHED NOW)

Aliases

nndiary-next-occurence (obsolete since 26.1)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nndiary.el.gz
(defun nndiary-next-occurrence (sched now)
  ;; Returns the next occurrence of schedule SCHED, starting from time NOW.
  ;; If there's no next occurrence, returns the last one (if any) which is then
  ;; in the past.
  (let* ((today (decode-time now))
	 (this-minute (decoded-time-minute today))
	 (this-hour (decoded-time-hour today))
	 (this-day (decoded-time-day today))
	 (this-month (decoded-time-month today))
	 (this-year (decoded-time-year today))
	 (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) #'<))
	 (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) #'<))
	 (dom-list (nth 2 sched))
	 (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) #'<))
	 (years (if (nth 4 sched)
		    (sort (nndiary-flatten (nth 4 sched) 1971) #'<)
		  t))
	 (dow-list (nth 5 sched))
	 (year (1- this-year))
	 (time-zone (or (and (nth 6 sched) (car (nth 6 sched)))
			(current-time-zone))))
    ;; Special case: an asterisk in one of the days specifications means that
    ;; only the other should be taken into account. If both are unspecified,
    ;; you would get all possible days in both.
    (cond ((null dow-list)
	   ;; this gets all days if dom-list is nil
	   (setq dom-list (nndiary-flatten dom-list 1 31)))
	  ((null dom-list)
	   ;; this also gets all days if dow-list is nil
	   (setq dow-list (nndiary-flatten dow-list 0 6)))
	  (t
	   (setq dom-list (nndiary-flatten dom-list 1 31))
	   (setq dow-list (nndiary-flatten dow-list 0 6))))
    ;; Remove past years.
    (unless (eq years t)
      (while (and (car years) (< (car years) this-year))
	(pop years)))
    (if years
	;; Because we might not be limited in years, we must guard against
	;; infinite loops. Apart from cases like Feb 31, there are probably
	;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to
	;; decide this, so I assume that if we reach 10 years later, the
	;; schedule is undecidable.
	(or
	 (catch 'found
	   (while (if (eq years t)
		      (and (setq year (1+ year))
			   (<= year (+ 10 this-year)))
		    (setq year (pop years)))
	     (let ((months month-list)
		   month)
	       ;; Remove past months for this year.
	       (and (= year this-year)
		    (while (and (car months) (< (car months) this-month))
		      (pop months)))
	       (while (setq month (pop months))
		 ;; Now we must merge the Dows with the Doms. To do that, we
		 ;; have to know which day is the 1st one for this month.
		 ;; Maybe there's simpler, but decode-time(encode-time) will
		 ;; give us the answer.
		 (let ((first (decoded-time-weekday
			       (decode-time
				(encode-time 0 0 0 1 month year
					     time-zone))))
		       (max (cond ((= month 2)
				   (if (date-leap-year-p year) 29 28))
				  ((<= month 7)
				   (if (zerop (% month 2)) 30 31))
				  (t
				   (if (zerop (% month 2)) 31 30))))
		       (doms dom-list)
		       (dows dow-list)
		       day days)
		   ;; first, review the doms to see if they are valid.
		   (while (setq day (pop doms))
		     (and (<= day max)
			  (push day days)))
		   ;; second add all possible dows
		   (while (setq day (pop dows))
		     ;; days start at 1.
		     (setq day (1+ (- day first)))
		     (and (< day 0) (setq day (+ 7 day)))
		     (while (<= day max)
		       (push day days)
		       (setq day (+ 7 day))))
		   ;; Aaaaaaall right. Now we have a valid list of DAYS for
		   ;; this month and this year.
		   (when days
		     (setq days (sort days #'<))
		     ;; Remove past days for this year and this month.
		     (and (= year this-year)
			  (= month this-month)
			  (while (and (car days) (< (car days) this-day))
			    (pop days)))
		     (while (setq day (pop days))
		       (let ((hours hour-list)
			     hour)
			 ;; Remove past hours for this year, this month and
			 ;; this day.
			 (and (= year this-year)
			      (= month this-month)
			      (= day this-day)
			      (while (and (car hours)
					  (< (car hours) this-hour))
				(pop hours)))
			 (while (setq hour (pop hours))
			   (let ((minutes minute-list)
				 minute)
			     ;; Remove past hours for this year, this month,
			     ;; this day and this hour.
			     (and (= year this-year)
				  (= month this-month)
				  (= day this-day)
				  (= hour this-hour)
				  (while (and (car minutes)
					      (< (car minutes) this-minute))
				    (pop minutes)))
			     (while (setq minute (pop minutes))
			       ;; Ouch! Here, we've got a complete valid
			       ;; schedule. It's a good one if it's in the
			       ;; future.
			       (let ((time (encode-time 0 minute hour day
							month year
							time-zone)))
				 (and (time-less-p now time)
				      (throw 'found time)))
			       ))))
		       ))
		   )))
	     ))
	 (nndiary-last-occurrence sched))
      ;; else
      (nndiary-last-occurrence sched))
    ))