;;; -*- Mode:Lisp; Package:CLUEI; Syntax:COMMON-LISP; Base:10; Lowercase:T; Patch-File: T;  -*-

(in-package "CLUEI")

#|| [Juergen Wed Jan 23 09:24:15 1991] 
Single- and double-click button events did not work, when the event
was created in a subwindow specifying no button events, since in this
case mouse-leaves and mouse-enters events are automatically generated
between button-press and button-release events.  Function
click-lookahead has been patched.  
||#


(defun click-lookahead (display count max first-time state first-x first-y)
  (declare (type card8 count)) ;; even when the button is UP, odd when DOWN
   (let* ((multipress-verify-p (display-multipress-verify-p display))
	 (multipress-delay-limit (display-multipress-delay-limit display))
	 (timeout (/  multipress-delay-limit 1000.0))
	 (distance-limit 5))
    
    (flet ((get-result (count timeoutp)
		       ;; If the result from GET-RESULT is NIL, all lookahead events
		       ;; remain on the event queue, otherwise the events are removed,
		       ;; and the result from GET-RESULT is returned.
		       (if (or (evenp count)	; Hold events only occur on timeout
			       timeoutp)
			   count
			   0)))
      (loop
	(let*
	  ((timeout-p t)
	   (result
	     (block result
	       ;; When succeeding, we want to "eat" the events.
	       ;; When failing, we want to leave events on the event queue.
	       ;; We're careful to return non-nil from event-case only on success.
	       ;; On failure, we return-from result, which leaves events on the queue.
	       ;; the timeout-p hair is to detect the difference between failure and timeout.
	       (event-case (display :timeout timeout :force-output-p nil)
		 ((motion-notify) (x y)		; Fail when pointer moves more than a jiggle
		  (setq timeout-p nil)
		  (when (> (+ (abs (- x first-x)) (abs (- y first-y))) distance-limit)
		    (return-from result (get-result count nil))))
		 
		 ((enter-notify leave-notify) (mode)	; Fail when pointer moves to a new window
		  ;(setq timeout-p nil)
		  (unless (member mode `(:grab :ungrab))
		    (setq timeout-p nil)
		    (return-from result (get-result count nil))))
		 
		 (button-press (time (state event-state) code)
			       (setq timeout-p nil)
			       (cond ((>= count max) (return-from result :count))
				     ((> time (+ first-time multipress-delay-limit))
				      (return-from result :timeout))
				     ((or (oddp count)
					  (not (= state (logior event-state (ash 1 (+ code button-0-shift))))))
				      (return-from result (get-result count nil)))
				     (t (let ((result (click-lookahead display (1+ count) max
								       time state first-x first-y)))
					  (if (plusp result)
					      result
					      (if (plusp (setq result (get-result count nil)))
						  (return-from result result)
						  nil ;; else fall-through returning NIL
						  ))))))
		 
		 (button-release (time (state event-state))
				 (setq timeout-p nil)
				 (cond ((>= count max) (return-from result :count))
				       ((> time (+ first-time multipress-delay-limit))
					(return-from result :timeout))
				       ((or (evenp count)
					    (not (= state event-state)))
					(return-from result (get-result count nil)))
				       (t (let ((result (click-lookahead display (1+ count) max
									 time state first-x first-y)))
					    (if (plusp result)
						result
						(if (plusp (setq result (get-result count nil)))
						    (return-from result result)
						    nil ;; else fall-through returning NIL
						    ))))))))))
	  
	  (if timeout-p
	      ;; event-case timed out
	      (if (or (zerop timeout)
		      (not multipress-verify-p))
		  
		  (return (get-result count :local-timeout))
		  
		  (progn
		    ;; Verify timeout with a server round-trip and event-queue recheck
		    (display-finish-output display)
		    (setq timeout 0)))
	      
	      ;; Else exit loop with result
	      (return (progn
			(case result
			(:timeout  (get-result (1- count) :timeout))
			(:count    0)
			((nil)     0)
			(otherwise result))))))))))
