#
# 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.

# routines to put frames up on screens and deal with geometry
# and property changes

# A simple widget to store properties of the toplevel window.
tkwm_widget::setdefaults frame client {
    {-manager manager Manager tkwmDefaultClientManager}
    {-opaqueMove opaqueMove OpaqueMove 0}
    {-opaqueResize opaqueResize OpaqueResize 0}
    {-constrained constrained Constrained 0}
    {-use_WM_STATE use_WM_STATE Use_WM_STATE 1}
}

proc client {var class args} {
    tkwm_widget::initialconfigure client $class $var args
    return $var
}

proc client::create {var} {
    upvar "#0" $var data
    bind $var <Destroy> [list client::destroy $var]
    set data(mapped) 0
}

proc client::destroy {var} {
    upvar "#0" $var data
    catch {$data(-manager) remove $var}
    tkwm_widget::destroy $var
}

proc client::command-map {var args} {
    upvar "#0" $var data
    set data(mapped) 1
    $data(-manager) map [winfo toplevel $var]
}

proc client::command-unmap {var args} {
    upvar "#0" $var data
    set data(mapped) 0
    $data(-manager) unmap [winfo toplevel $var]
}

proc client::config-opaqueMove {var option} {}
proc client::config-opaqueResize {var option} {}
proc client::config-constrained {var option} {}
proc client::config-use_WM_STATE {var option} {}
proc client::config-manager {var option} {
    upvar "#0" $var data
    catch {$data(-manager) remove [winfo toplevel $var]}
    set data(-manager) $option
    if $data(mapped) {$data(-manager) map [winfo toplevel $var]}
}

# Figure out where the window goes.

proc compute_size_and_position {startup win} {
    if {!$startup && ![$win.plug info USPosition] && ![$win.plug info transient_for]} {
	# Compute the users requested position.
	# WARNING: The window can disappear during this procedure.
	set pos [user_pos $win]
	# Check if the window is still around and display it the requested position
        if [winfo exists $win] {wm geometry $win $pos}
    }
}

proc user_pos {win} {
    global tkwm_priv tkwm_libpath

    # initially we have decided nothing.
    set tkwm_priv(done) ""
    set tkwm_priv(position) ""

    scan [tkwm pointer] "%d %d" x y
    set tkwm_priv(width) [winfo width $win]
    set tkwm_priv(height) [winfo height $win]
    set tkwm_priv(constrained) [get_resource_value $win constrained Constrained]
    set tkwm_priv(xmax) [expr [winfo screenwidth $win]-[winfo width $win]]
    set tkwm_priv(ymax) [expr [winfo screenheight $win]-[winfo height $win]]
    if $tkwm_priv(constrained) {
        if {"$x"<"0"} {set x 0}
        if {"$y"<"0"} {set y 0}
        if {"$x">"$tkwm_priv(xmax)"} {set x $tkwm_priv(xmax)}
        if {"$y">"$tkwm_priv(ymax)"} {set y $tkwm_priv(ymax)}
    }

    label .notifier -text "+$x+$y" -width 12 -height 1 -rel raised -border 2

    # initially place off viewable screen, so we can grab without displaying
    place .notifier -x 0 -y -100
    update idletasks
    tkwait visibility .notifier

    # Grab the pointer, but not the keyboard so keyboard events don't
    # get "lost".
    grabpointer -cursor top_left_corner
    set tkwm_priv(cursor) [lindex [. config -cursor] 4]
    # doing this config will cause the root window color to be
    # updated, thus we loose whatever background image the user has.
    # I really need to make some changes in the core to fix this.
#    . config -cursor top_left_corner

    # This grab redirects events to the .notifier, and at the same
    # time waits until any existing global grabs go away. (The later
    # relies on a modified semantics of "grab" as implemented in
    # functions.tcl.) The later is important so that we don't interupt
    # some global dialog, such as a menu selection, with a request to
    # position the window.
    grab set .notifier

    # grab the server so updates of clients don't mess up the outline tracing
    # The server grab MUST be done after other types of grabs, otherwise
    # looping for other grabs can lock up forever.
    tkwm grabserver

    # Push on the root colormap so we can see the outline
    install_root_colormap

    # protect the code so that if it fails we still finish the ungrabserver.
    unwindProtect {
	# move the notifier onto the screen.
	place .notifier -x 0 -y 0
	tkwm outline $x $y $tkwm_priv(width) $tkwm_priv(height)
	focus .notifier
	
	bind .notifier <ButtonPress-1> {
	    global tkwm_priv
	    set x %X
	    set y %Y
	    if $tkwm_priv(constrained) {
		if {"$x"<"0"} {set x 0}
		if {"$y"<"0"} {set y 0}
		if {"$x">"$tkwm_priv(xmax)"} {set x $tkwm_priv(xmax)}
		if {"$y">"$tkwm_priv(ymax)"} {set y $tkwm_priv(ymax)}
	    }
	    set tkwm_priv(position) "+$x+$y"
	    tkwm outline $x $y $tkwm_priv(width) $tkwm_priv(height)
	    # bind inside here just in case a button release preceeds the
	    # button press.
	    bind .notifier <ButtonRelease-1> {
		unwindProtect {
		    global tkwm_priv

		    # these two lines are needed to avoid a bug in TK (fixed in 3.4 & 3.5?)
		    grab release .notifier
		    # WARNING: the target window can cease to exists during this update.
		    update
		    destroy .notifier
		    tkwm outline 0 0 0 0
		    # actually clear the outline from the screen so we don't get "droppings"
		    # and make sure the notifier box goes away right away.
		    update idletasks
		    update
		} {
		    # make sure the tkwait can finish!
		    set tkwm_priv(done) 1
		}
	    }
	}
 	
	bind .notifier <Any-Motion> {
	    global tkwm_priv
	    if {$tkwm_priv(position)==""} {
		set x %X
		set y %Y
		if $tkwm_priv(constrained) {
		    if {"$x"<"0"} {set x 0}
		    if {"$y"<"0"} {set y 0}
		    if {"$x">"$tkwm_priv(xmax)"} {set x $tkwm_priv(xmax)}
		    if {"$y">"$tkwm_priv(ymax)"} {set y $tkwm_priv(ymax)}
		}
	        .notifier config -text "+$x+$y"
	        tkwm outline $x $y $tkwm_priv(width) $tkwm_priv(height)
	    }
	}
        # The target window can cease to exists during this wait.
        tkwait variable tkwm_priv(done)
    } {
	catch {tkwm ungrabserver}
        # give back the root cursor
#        catch {. config -cursor $tkwm_priv(cursor)}
	# Give back the colormap
        catch {uninstall_root_colormap}
	# release our grabs no matter what
        catch {ungrabpointer}
    }
    return $tkwm_priv(position)
}

proc create_client_window {win} {
    global window_list
    # this is the array that will hold this windows private information
    upvar #0 .$win data

    set tkwin .$win
    toplevel $tkwin -class Client

    # don't display the window yet!
    wm withdraw $tkwin

    # grab the server so we get a chance to set up the window
    # heirearchy before clients start asking what it looks like.
    tkwm grabserver

    handleError {
	tkwm plug $tkwin.plug $win -frame $tkwin -setgrid 1 -background black
    } {
	# the window no longer exists
	destroy $tkwin
	catch {tkwm ungrabserver}
	return
    }

    unwindProtect {
	# get the requested size and position from the plug now
	# so we don't loose it if an update gets run (for example in tkerror!)
	scan [$tkwin.plug geometry] "%dx%d%s" width height position
	# set the size of the window so that an update after this doesn't
	# force an unneeded reconfiguration of the child.
	wm geometry $tkwin ${width}x${height}

	lappend window_list $tkwin

	# build a dummy frame that we use to access application
	# specific resources. Note: We must make sure that the first character
	# is lower case, and that there are no "." characters in the name.
	# We do this by lowercasing the first character and changing "."'s
	# into "_"'s.
	set res_name [retarget_res_name $tkwin [$tkwin.plug info res_name]]
	handleError {
	    set data(res_name) $tkwin.$res_name
	    client $data(res_name) [$tkwin.plug info res_class]
	} {
	    # the resource name didn't fly. Do the expensive work to muck it over.
	    set s [split $res_name {}]
	    set s [concat [string tolower [lindex $s 0]] [lrange $s 1 end]]
	    set t {}
	    foreach i $s {if {$i=="."} {lappend t "_"} {lappend t $i}}
	    set s [join $t {}]
	    set data(res_name) $tkwin.$s
	    client $data(res_name) [$tkwin.plug info res_class]
	}
	pack $data(res_name) -expand 1 -fill both

	# create the heirarchy referents other than data(res_name)
	set data(root) $tkwin
	set data(root-plug) $tkwin.plug
	if [$tkwin.plug info transient_for] {
	    set data(decoration)  $data(res_name).transient-decoration
	} else {
	    set data(decoration)  $data(res_name).decoration
	}

	# determine which room this application starts in
	register transient .[$tkwin.plug info transient_for] $tkwin
	register group .[$tkwin.plug info window_group] $tkwin

	handleError {
	    register room [choose_room $tkwin.plug] $tkwin
	} {
	    register room global $tkwin
	    tkerror "User choose room code failed"
	}

	# catch the destruction of the plug by the client and get
	# rid of related data structures.
	# Note that the destruction of a plug destroys the plugs "frame"
	# window (as set by "-frame"), so we don't need to do the destroy
	# ourselves here. Also, don't try to destroy a parent of a plug
	# frame within this binding, because that will cause the current
	# version (3.4) of TK to go into an infinite loop.
	bind $tkwin.plug <Destroy> "deregister $tkwin; \
	    global window_list $tkwin; \
	    set_remove window_list $tkwin; unset $tkwin"

	# do the decorations
	handleError {
	    set inside [tkwm_client_frame $data(decoration) \
			    -title [$tkwin.plug info name]]
	} {
	    # The users decoration command screwed up.
	    # Do a very quick and dirty packing.
	    global errorInfo
	    set se $errorInfo
	    catch {destroy $data(decoration)}
	    set inside [frame $data(decoration) \
			    -relief ridge \
			    -border 5 \
			    -cursor top_left_arrow]
	    set errorInfo $se
	    tkerror "User decoration code failed"
	}
	pack $data(decoration) -anchor nw -expand 1 -fill both
	pack $tkwin.plug -in $inside -anchor nw -expand 1 -fill both
	raise $tkwin.plug

	# Set the requested size and position. The first update is needed so
	# that changes in the border size don't screw up placement of negative
	# geometries. The second update is needed because size changes are
	# held over until idle.
	# Note that the sendconfig must occur before the update idletasks!
	update idletasks
	wm geometry $tkwin $position
	$tkwin.plug sendconfig
	update idletasks

	# bind the events for the frame.

	noisyCatch {frame_bindings $tkwin}

	# The window may have ceased to exist by this point!
	# check so the user doesn't get an error dialog.
	if [winfo exists $tkwin.plug] {
	    if {[$tkwin.plug hasShape]} {
		$tkwin.plug shapify
	    }
	}
    } {
	catch {tkwm ungrabserver}
    }

    return $tkwin
}

proc map_request {tkwin win} {
    global tkwm_priv
    upvar "#0" .$win data
    
    if {$tkwin == "startup"} {
	set startup "1"
	set tkwin "??"
    } else {
	set startup "0"
    }
    
    if {$tkwin == "??"} {
	# WARNING: The window may have ceased to exist after this call.
	set tkwin [create_client_window $win]
        # if the window was destroyed before we got here, just skip everything.
        if ![winfo exists $tkwin] {return}
	set data(state) "withdrawn"
    } else {
        catch {set tkwin [lindex [$tkwin config -frame] 4]}
	if ![info exists data(state)] {set data(state) "withdrawn"}
    }

    set initial_state [$tkwin.plug info initial_state]
    # get the old state if we're suppose to be using it.
    if [get_resource_value $tkwin use_WM_STATE Use_WM_STATE] {
        set newstate [lindex [$tkwin.plug config -state] 4]
	if {$newstate=="withdrawn"} {set newstate $initial_state}
    } else {
	set newstate $initial_state
    }

    if {$data(state) == "iconified"} {
	# transition from iconified to normal
	deiconify $tkwin
    } else {
	# transition from withdrawn
	if {$newstate == "normal"} {
            # transition from withdrawn to normal
	    # WARNING: the window can disappear during this next procedure.
	    compute_size_and_position $startup $tkwin
	    # if the window disappeared on us then skip out.
            if ![winfo exists $tkwin] {return}
	    # make sure geometry computations complete
 	    update idletasks
	    deiconify $tkwin
	} else {
            # transition from withdrawn to iconic
	    # windows that are iconic on startup better be sure to specify
	    # their location, or they end up at +0+0
	    wm geometry $tkwin [$tkwin.plug geometry]
	    # make sure geometry computations complete
 	    update idletasks
	    iconify $tkwin
	}
    }

    # if the window has an icon window (as opposed to a pixmap icon),
    # then create the icon window now since we really don't
    # want the icon window to just float about on the screen
    # until the first time we iconify the client.
    if {[winfo exists $tkwin] && ![info exists data(icon)]
    && [$tkwin.plug info icon_window] != "??"} {
        create_icon_window $tkwin
    }

    # Make sure the client knows where it ended up
    $tkwin.plug sendconfig
    update idletasks

    # Make the changes display right now
    update
}

tkwm bind <ShapeNotify> {noisyCatch {%W shapify}}

tkwm bind <MapRequest> {dispatch {noisyCatch {map_request %W %e}}}

tkwm bind <Configure> {noisyCatch {configureClient %W %w %h %x %y %d %S}}

# This code is so complicated because it needs to deal with the
# gravity of the configured window correctly.
# I could have put this in the core, but that would have precluded
# this code eventually paying attention to maximum and minimum window
# sizes and such things.
proc configureClient {W w h X Y d S} {
    if {"$w" != "??" && "$h" != "??" && $w>="0" && $h>="0"} {set size "${w}x$h"}
    if {"$X" != "??" && "$Y" != "??"} {set x $X; set y $Y}
    set frame [lindex [$W config -frame] 4]
    # instead of doing an update this code should compute the
    # size from the plug information. This avoids resizing before
    # moving, and also resizing only to resize smaller/larger to
    # meet max/min thresholds.
    if [info exists size] {wm geometry $frame $size; update idletasks}
    set w [winfo width $frame.plug]
    set h [winfo height $frame.plug]
    if {[info exists x] && [info exists y]} {
	switch [$W info win_gravity] {
	    "1" {
	       set x "+$x"
	       set y "+$y"
	    }
	    "3" {
	       set x "-[expr [winfo screenwidth $frame]-($x+$w)]"
	       set y "+$y"
	    }
	    "7" {
	       set x "+$x"
	       set y "-[expr [winfo screenheight $frame]-($y+$h)]"
	    }
	    "9" {
	       set x "-[expr [winfo screenwidth $frame]-($x+$w)]"
	       set y "-[expr [winfo screenheight $frame]-($y+$h)]"
	    }
	}
	wm geometry $frame $x$y
    }
    if {"$d" != "??" && "$S" != "??"} {
      update idletasks
      restack $frame $d $S
    }
    $W sendconfig
    update idletasks
}

tkwm bind <Iconify> {iconify [lindex [%W config -frame] 4]}

#this should deal with changes in icon_name and name.
#I'm not sure if any other possible changes call for action on
#the window managers part, other than reading the changed hints,
#which is done at the C code level. I should examine each property
#change to decide what should happen.

tkwm bind <Property> {
    noisyCatch {
	upvar "#0" [lindex [%W config -frame] 4] data
	switch "%P" {
	    WM_NAME {
		catch {
		    $data(decoration) config -title [%W info name]
		}
	    }
	    WM_ICON_NAME {
		catch {
		    $data(icon.decoration) config -title [%W info icon_name]
		}
	    }
	    WM_HINTS {
		# watch for changes in the icon bitmap, position, etc..
		catch {
		    # change the icon bitmap if we can...
		    $data(icon) config -bitmap [%W info icon_pixmap]
		}
	    }
	}
    }
}