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

proc make_icon_plug {name client} {
    global $client

    set width [get_resource_value $client iconWidth IconWidth]
    set height [get_resource_value $client iconHeight IconHeight]

    handleError {
	set icon_window [tkwm info icon_window $client]
	set icon_pixmap [tkwm info icon_pixmap $client]
    } {
	# this client is an internal window, not a client
	# we can't do icon window's for internal clients right now...
	set icon_window ??
	set icon_pixmap [wm iconbitmap $client]
    }

    if {$icon_window != "??"} {
	frame $name -bor 0 -height $height -width $width
	tkwm plug $name.w $icon_window -setgrid 0
        $client.plug configure -iconwin $icon_window
	pack propagate $name 0
	pack $name.w -expand 1 -fill both
    } else {
	# adjust the width and height to account for the 1 pixel border
        # the label widget will force on us.
	incr width -2
	incr height -2
	set bitmap [get_resource_value $client iconBitmap IconBitmap]
	if {$bitmap == ""} {set bitmap $icon_pixmap}
	if {$bitmap == ""} {set bitmap question}
	handleError {
	    label $name -bor 0 -padx 0 -pady 0 -height $height -width $width -bitmap $bitmap
	} {
	    label $name -bor 0 -padx 0 -pady 0 -height $height -width $width -bitmap question
	}
    }
}

proc make_icon {name client} {
    global $client

    handleError {
	set icon_name [$client.plug info icon_name]
	set icon_x [$client.plug info icon_x]
	set icon_y [$client.plug info icon_y]
    } {
	# This is an internal client
	set icon_name [wm iconname $client]
        set icon_x ??
	set icon_y ??
	scan [wm iconposition $client] icon_x icon_y
    }

    toplevel $name
    wm withdraw $name
    handleError {
	set inside [tkwm_icon_frame $name.decoration \
			-title $icon_name \
			-titlebar [get_resource_value \
					$client iconTitled IconTitled]]
    } {
	catch {destroy $name.decoration}
	set inside [frame $name.decoration \
			-relief ridge \
			-borderwidth 5
			-cursor "top_left_arrow"]
	tkerror "User icon decoration code failed"
    }
    make_icon_plug $name.plug $client
    pack $name.decoration -expand 1 -fill both
    pack $name.plug -in $inside -expand 1 -fill both
    if {$icon_x!="??" && $icon_y!="??"} {
	wm geometry $name +$icon_x+$icon_y
    } else {
	wm geometry $name +[winfo rootx $client]+[winfo rooty $client]
    }
    # make sure the icon size is known.
    update idletasks
}