#
# Copyright (c) 1993 Eric Schenk.
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL ERIC SCHENK BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF ERIC
# SCHENK HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# ERIC SCHENK SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND ERIC SCHENK HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

# bindings and commands to show changes in focus

set tkwm_priv(lastfocus) None

# change the keyboard focus to window w
proc change_focus {w} {
    global tkwm_priv
    set w [winfo toplevel $w]
    if {$tkwm_priv(lastfocus) == $w} {return}

    if {$w == "."} {
	tkwm focus None
    } else {
	handleError {
	    if {[$w.plug info input] != "0"} {
		# ICCCM says to only set the focus for windows with this hint
                # true, but some clients loose and fail to set the hint,
                # so if they failed to set it assume they set it to true.
		tkwm focus $w
	    } else {
		# If the window won't take the focus, set it to the root
		# so that it doesn't float around in the last window we
		# had the cursor over.
		tkwm focus None
	    }
	    if {[lsearch [$w.plug info protocols] WM_TAKE_FOCUS]!="-1"} {
		# ICCCM says to send a WM_TAKE_FOCUS event in this case.
		$w.plug take_focus
	    }
	} {
	    # we are focusing on an internal client.
	    tkwm focus None
        }
    }
    notice_focus_change $w
}

proc notice_focus_change {w} {
    global tkwm_priv
    set w [winfo toplevel $w]
    if {$tkwm_priv(lastfocus) == $w} {return}

    upvar "#0" $w data
    upvar "#0" $tkwm_priv(lastfocus) olddata

    focus $w
    set_colormap $w

    if {$tkwm_priv(lastfocus) != "."} {
	catch {$olddata(decoration) deactivate}
    }
    if {$w != "."} {
	catch {$data(decoration) activate}
    }
    set tkwm_priv(lastfocus) $w
}

bind . <Any-Enter> {change_focus %W}
bind Client <Any-Enter> {if {"%d" != "NotifyInferior"} {change_focus %W}}
bind Icon <Any-Enter> {if {"%d" != "NotifyInferior"} {change_focus %W}}
bind Toplevel <Any-Enter> {if {"%d" != "NotifyInferior"} {change_focus %W}}

# monitor for requests to change the focus by a client.
tkwm bind <FocusIn> {if {"%W"!="??"} {notice_focus_change %W}}

# Colormap focus utility routines
set tkwm_priv(root_pushes) 0

proc install_root_colormap {} {
    global tkwm_priv
    incr tkwm_priv(root_pushes)
    # Just in case... I don't actually think this should ever fail.
    catch {tkwm colormap .}
}

proc uninstall_root_colormap {} {
    global tkwm_priv
    incr tkwm_priv(root_pushes) "-1"
    if {$tkwm_priv(root_pushes) <= "0"} {
	set tkwm_priv(root_pushes) 0
	# Just in case... I don't actually think this should ever fail.
	catch {tkwm colormap $tkwm_priv(colormap)}
    }
}

proc set_colormap {w} {
    global tkwm_priv
    set tkwm_priv(colormap) $w
    # Actually do the install if the root colormap is not force loaded
    if {$tkwm_priv(root_pushes) == "0"} {
	# Just in case... I don't actually think this should ever fail.
        catch {tkwm colormap $w}
    }
}