;;;;
;;;; Focus management
;;;;
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; Permission to use, copy, modify, distribute,and license this
;;;; software and its documentation for any purpose is hereby granted,
;;;; provided that existing copyright notices are retained in all
;;;; copies and that this notice is included verbatim in any
;;;; distributions.  No written agreement, license, or royalty fee is
;;;; required for any of the authorized uses.
;;;; This software is provided ``AS IS'' without express or implied
;;;; warranty.
;;;;
;;;; This software is a derivative work of other copyrighted softwares; the
;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
;;;;
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date: 27-Jul-1995 14:10
;;;; Last file update:  3-Sep-1999 19:51 (eg)
;;;;

(select-module Tk)

;; tk_focusNext --
;; This procedure returns the name of the next window after "w" in
;; "focus order" (the window that should receive the focus next if
;; Tab is typed in w).  "Next" is defined by a pre-order search
;; of a top-level and its non-top-level descendants, with the stacking
;; order determining the order of siblings.  The "-takefocus" options
;; on windows determine whether or not they should be skipped.

(define Tk:focus-on  	(lambda (w) #t))
(define Tk:focus-off	(lambda (w) #f))

(define Tk:focus-next 	#f)	; will be redefined below
(define Tk:focus-prev	#f)	; will be redefined below

(let ()
  (define (all-children w)
    (let ((res '()))
      (for-each (lambda (x)
		  (unless (equal? x (winfo 'toplevel x))
		      ;; x is not a toplevel
			  (set! res (append res (all-children x)))))
		(winfo 'children w))
      (cons w res)))

   (define (focusable? w)
     (let ((focus #t)
	   (value #f))

       (if (winfo 'viewable w)
	   (begin
	     ;; 1. See if this window tells something in its :takefocus option
	     (if (not (catch (set! value (tk-get w :takefocus))))
		 ;; widget has :takefocus option
		 ;; Remark: :takefocus option must be a closure. But original 
		 ;; Tcl/Tk code can define the focus action as "0" or "1".
		 ;; Those values can be hard-coded in the Tk library. So take them
		 ;; into account
		 (cond 
		    ((boolean? value) (set! focus value))
		    ((closure? value) (set! focus (value w)))))

	     ;; 2. See if the window is not disabled
	     (if focus
		 (if (not (catch (set! value (tk-get w :state))))
		     ;; widget has a :state option
		     (set! focus (not (equal? value "disabled")))))

	     ;; 3. Claim that the window is focuable inly if it exist some
	     ;;    keyboard binding associated to it
	     (if focus
		 (let ((p (open-output-string)))
		   (display (bind w) p)
		   (display (bind (winfo 'class w)) p)
		   (let ((s (get-output-string p)))
		     (set! focus (or (string-find? "Key" s)
				     (string-find? "Focus" s)))))))
	   ;; w is not visible
	   (set! focus #f))
       focus))

  (define (find-next w l)
    (let* ((len   (length l))
	   (index (- len (length (member w l)))))

      ;; index is the position of the current widget in l
      (let loop ((i (modulo (+ index 1) len)))
	   (if (= i index)
	       ;; not found, return w
	       w
	       (let ((widget (list-ref l i)))
		 (if (focusable? widget)
		     widget
		     (loop (modulo (+ i 1) len))))))))

  
  (set! Tk:focus-next 
	(lambda (w)
	  (let ((all (all-children (winfo 'toplevel w))))
	    (if (= (length all) 1)
		(car all)
		(find-next w all)))))

  (set! Tk:focus-prev
	(lambda (w)
	  (let ((all (all-children (winfo 'toplevel w))))
	    (if (= (length all) 1)
		(car all)
		(find-next w (reverse all)))))))


(define (Tk:focus-follows-mouse)
  (let ((old    (bind "all" "<Enter>"))
	(script (lambda(|W| d)
		  (if (or (equal? d "NotifyAncestor")
			  (equal? d "NotifyNonlinear")
			  (equal? d "NotifyInferior"))
		      (focus |W|)))))
    (add-binding "all" "<Enter>" script #f)))

 


