;;;; stop-focus.jl -- focuses a window when the cursor enters the
;;;; window and remains stationary for a period of time.

;; Copyright (C) 2000 John Kodis <kodis@jagunet.com>.  The sawfish
;; stop-focus.jl module is based on hover-focus.jl by Nils Barth,
;; which was influenced by scwm's hover-focus.scm by John Kodis and
;; Greg Badros, which was in turn based on scwm's auto-raise.scm by
;; Maciej Stachowiak and Greg Badros.  That's one hell of a pedigree
;; for a hundred lines of code.

;; This file is free software distributed under the terms of the GNU
;; General Public License; either version 2, or (at your option) any
;; later version.  You should have received a copy of the GNU General
;; Public License along with sawfish; see the file COPYING.  If not,
;; write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA
;; 02139, USA.

(require 'timers)
(require 'sawfish.wm.focus)
(provide 'stop-focus)

;; Variables

(defcustom stop-focus-delay 250
  "Delay in milliseconds until a window gains focus (in stop-focus mode)."
  :group (focus)
  :type number
  :range (0 . 5000))

(defcustom stop-focus-slop 10
  "Distance the cursor can move when stopped (in stop-focus mode)."
  :group (focus)
  :type number
  :range (0 . 5000))

(defvar stop-focus-timer nil)
(defvar stop-focus-positions nil)
(defvar stop-focus-count nil)
(defvar stop-focus-interval nil)

;; Functions

;; motion -- approximates the distance from the eldest saved pointer
;; position to the current pointer location.
(defun motion ()
  (let* ((point (query-pointer))
	 (dx (abs (- (caar stop-focus-positions) (car point))))
	 (dy (abs (- (cdar stop-focus-positions) (cdr point)))))
    (+ (max dx dy) (/ (min dx dy) 2))))

;; stopped-p -- determines if the pointer has stopped, based on motion
;; and allowable position slop.
(defun stopped-p ()
  (and (>= (length stop-focus-positions) stop-focus-count)
       (< (motion) stop-focus-slop)))

;; stop-focus-timer-handler -- focuses a window if stopped, otherwise
;; re-arms timer and pushes a new position onto the position list.
(defun stop-focus-timer-handler (w)
;  (format standard-error "timer: %s, %d, %d\n"
;	  w (length stop-focus-positions) (truncate (motion)))
  (if (stopped-p)
      (when (window-really-wants-input-p w) (set-input-focus w))
    (set-timer stop-focus-timer 0 stop-focus-interval)
    (when (>= (length stop-focus-positions) stop-focus-count)
      (setq stop-focus-positions (cdr stop-focus-positions)))
    (setq stop-focus-positions
	  (append stop-focus-positions (list (query-pointer))))))

;; stop-focus-set-timer-values -- tries to split stop-focus-delay into
;; max-count intervals (arbitrarily chosen as 5), unless this would
;; reduce the interval below min-interval (20 ms, intended to reflect what
;; can be scheduled reliably), in which case fewer intervals are used.
(defun stop-focus-set-timer-values ()
  (let* ((max-count 5)
	 (min-interval 20)
	 (stop-time stop-focus-delay)
	 (count (max 1 (min max-count (quotient stop-time min-interval))))
	 (interval (max min-interval (quotient stop-time count))))
    (setq stop-focus-count count)
    (setq stop-focus-interval interval)))

;; stop-focus-enter -- triggered on entering any window in stop-focus
;; mode.  Pushes the current pointer on the positions list, computes
;; timer parameters, and starts the focus timer running.
(defun stop-focus-enter (w)
;  (format standard-error "enter: %s\n" w)
  (if (zerop stop-focus-delay)
      (when (window-really-wants-input-p w) (set-input-focus w))
    (unless (eq w (input-focus))
      (setq stop-focus-positions (list (query-pointer)))
      (stop-focus-set-timer-values)
      (setq stop-focus-timer
	    (make-timer (lambda () (stop-focus-timer-handler w))
			0 stop-focus-interval)))))

;; stop-focus-leave -- cleans up on exiting a window by deleting the
;; focus timer.
(defun stop-focus-leave (w)
;  (format standard-error "leave: %s\n" w)
  (when stop-focus-timer
    (delete-timer stop-focus-timer)
    (setq stop-focus-timer nil)))

(define-focus-mode 'stop-focus
  (lambda (w action)
    (cond ((eq action 'pointer-in) (stop-focus-enter w))
          ((eq action 'pointer-out) (stop-focus-leave w)))))