;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CLUEI; Base: 10; -*-

;;; 07/31/1992 (Juergen)  
;;;
;;; Using timers with very small time intervals caused a loop within the
;;; execute-timers functions, so that no other events could be processed.
;;; execute-timers has been changed to return when the same timer object
;;; is processed twice.
 
(in-package :cluei)

(defun execute-timers (display)
  "Execute all timers whose time has come, returning the time (in seconds)
 before the next timer executes for DISPLAY"
  (let ((executed-timers nil))
    (loop
    (let ((next-timer (car (timer-queue display))))

      (unless next-timer
	;; No timers active
	(return nil))

      (let ((next-time  (timer-time next-timer)))
	(when (or ;; *** one of the executed-timers again -> loop
	          (member next-timer executed-timers :test #'eq)
		  (> next-time (get-internal-real-time)))
	  ;; Return time interval before next timer fires
	  (return
	    (/ (- next-time (get-internal-real-time))
	       #.(float internal-time-units-per-second)))))

      ;; *** save current timer in executed-timers
      (push next-timer executed-timers)

      ;; Reinsert timer for next firing
      (pop (timer-queue display)) ;; Warning: If an abort happens here, There's a short
      (insert-timer next-timer)   ;;          interval where a timer may be lost.

      ;; Dispatch a :timer event
      (let ((event (allocate-event)))
	(with-slots ((event-display display)
		     name data) (the event event)
	  (setf event-display display
		name (timer-name next-timer)
		data (timer-data next-timer)))
	(dispatch-event event :timer nil 0 (timer-contact next-timer))
	(deallocate-event event))))))