# msgbox.tcl --

#

#	Implements messageboxes for platforms that do not have native

#	messagebox support.

#

# RCS: @(#) $Id: msgbox.tcl,v 1.24.2.2 2004/05/13 23:28:34 dkf Exp $

#

# Copyright (c) 1994-1997 Sun Microsystems, Inc.

#

# See the file "license.terms" for information on usage and redistribution

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#

# Ensure existence of ::tk::dialog namespace

#

namespace eval ::tk::dialog {}

image create bitmap ::tk::dialog::b1 -foreground black \

-data "#define b1_width 32\n#define b1_height 32

static unsigned char q1_bits[] = {

   0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,

   0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,

   0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,

   0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,

   0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,

   0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,

   0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,

   0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,

   0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,

   0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"

image create bitmap ::tk::dialog::b2 -foreground white \

-data "#define b2_width 32\n#define b2_height 32

static unsigned char b2_bits[] = {

   0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,

   0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,

   0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,

   0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,

   0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,

   0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,

   0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,

   0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,

   0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,

   0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"

image create bitmap ::tk::dialog::q -foreground blue \

-data "#define q_width 32\n#define q_height 32

static unsigned char q_bits[] = {

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,

   0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,

   0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,

   0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,

   0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"

image create bitmap ::tk::dialog::i -foreground blue \

-data "#define i_width 32\n#define i_height 32

static unsigned char i_bits[] = {

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,

   0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,

   0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,

   0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,

   0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"

image create bitmap ::tk::dialog::w1 -foreground black \

-data "#define w1_width 32\n#define w1_height 32

static unsigned char w1_bits[] = {

   0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,

   0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,

   0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,

   0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,

   0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,

   0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,

   0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,

   0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,

   0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,

   0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,

   0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};"

image create bitmap ::tk::dialog::w2 -foreground yellow \

-data "#define w2_width 32\n#define w2_height 32

static unsigned char w2_bits[] = {

   0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,

   0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,

   0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,

   0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,

   0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,

   0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,

   0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,

   0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,

   0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,

   0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"

image create bitmap ::tk::dialog::w3 -foreground black \

-data "#define w3_width 32\n#define w3_height 32

static unsigned char w3_bits[] = {

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,

   0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,

   0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,

   0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,

   0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,

   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"

# ::tk::MessageBox --

#

#	Pops up a messagebox with an application-supplied message with

#	an icon and a list of buttons. This procedure will be called

#	by tk_messageBox if the platform does not have native

#	messagebox support, or if the particular type of messagebox is

#	not supported natively.

#

#	Color icons are used on Unix displays that have a color

#	depth of 4 or more and $tk_strictMotif is not on.

#

#	This procedure is a private procedure shouldn't be called

#	directly. Call tk_messageBox instead.

#

#	See the user documentation for details on what tk_messageBox does.

#

proc ::tk::MessageBox {args} {

    global tcl_platform tk_strictMotif

    variable ::tk::Priv

    set w ::tk::PrivMsgBox

    upvar $w data

    #

    # The default value of the title is space (" ") not the empty string

    # because for some window managers, a 

    #		wm title .foo ""

    # causes the window title to be "foo" instead of the empty string.

    #

    set specs {

	{-default "" "" ""}

        {-icon "" "" "info"}

        {-message "" "" ""}

        {-parent "" "" .}

        {-title "" "" " "}

        {-type "" "" "ok"}

    }

    tclParseConfigSpec $w $specs "" $args

    if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {

	error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"

    }

    if {[string equal [tk windowingsystem] "classic"]

	    || [string equal [tk windowingsystem] "aqua"]} {

	switch -- $data(-icon) {

	    "error"     {set data(-icon) "stop"}

	    "warning"   {set data(-icon) "caution"}

	    "info"      {set data(-icon) "note"}

	}

    }

    if {![winfo exists $data(-parent)]} {

	error "bad window path name \"$data(-parent)\""

    }

    switch -- $data(-type) {

	abortretryignore { 

	    set names [list abort retry ignore]

	    set labels [list &Abort &Retry &Ignore]

	}

	ok {

	    set names [list ok]

	    set labels {&OK}

	}

	okcancel {

	    set names [list ok cancel]

	    set labels [list &OK &Cancel]

	}

	retrycancel {

	    set names [list retry cancel]

	    set labels [list &Retry &Cancel]

	}

	yesno {

	    set names [list yes no]

	    set labels [list &Yes &No]

	}

	yesnocancel {

	    set names [list yes no cancel]

	    set labels [list &Yes &No &Cancel]

	}

	default {

	    error "bad -type value \"$data(-type)\": must be\

		    abortretryignore, ok, okcancel, retrycancel,\

		    yesno, or yesnocancel"

	}

    }

    set buttons {}

    foreach name $names lab $labels {

	lappend buttons [list $name -text [mc $lab]]

    }

    # If no default button was specified, the default default is the 

    # first button (Bug: 2218).

    if {$data(-default) == ""} {

	set data(-default) [lindex [lindex $buttons 0] 0]

    }

    set valid 0

    foreach btn $buttons {

	if {[string equal [lindex $btn 0] $data(-default)]} {

	    set valid 1

	    break

	}

    }

    if {!$valid} {

	error "invalid default button \"$data(-default)\""

    }

    # 2. Set the dialog to be a child window of $parent

    #

    #

    if {[string compare $data(-parent) .]} {

	set w $data(-parent).__tk__messagebox

    } else {

	set w .__tk__messagebox

    }

    # 3. Create the top-level window and divide it into top

    # and bottom parts.

    catch {destroy $w}

    toplevel $w -class Dialog

    wm title $w $data(-title)

    wm iconname $w Dialog

    wm protocol $w WM_DELETE_WINDOW { }

    # There is only one background colour for the whole dialog

    set bg [$w cget -background]

    # Message boxes should be transient with respect to their parent so that

    # they always stay on top of the parent window.  But some window managers

    # will simply create the child window as withdrawn if the parent is not

    # viewable (because it is withdrawn or iconified).  This is not good for

    # "grab"bed windows.  So only make the message box transient if the parent

    # is viewable.

    #

    if {[winfo viewable [winfo toplevel $data(-parent)]] } {

	wm transient $w $data(-parent)

    }    

    if {[string equal [tk windowingsystem] "classic"]

	    || [string equal [tk windowingsystem] "aqua"]} {

	unsupported::MacWindowStyle style $w dBoxProc

    }

    frame $w.bot -background $bg

    pack $w.bot -side bottom -fill both

    frame $w.top -background $bg

    pack $w.top -side top -fill both -expand 1

    if {![string equal [tk windowingsystem] "classic"]

	    && ![string equal [tk windowingsystem] "aqua"]} {

	$w.bot configure -relief raised -bd 1

	$w.top configure -relief raised -bd 1

    }

    # 4. Fill the top part with bitmap and message (use the option

    # database for -wraplength and -font so that they can be

    # overridden by the caller).

    option add *Dialog.msg.wrapLength 3i widgetDefault

    if {[string equal [tk windowingsystem] "classic"]

	    || [string equal [tk windowingsystem] "aqua"]} {

	option add *Dialog.msg.font system widgetDefault

    } else {

	option add *Dialog.msg.font {Times 14} widgetDefault

    }

    label $w.msg -anchor nw -justify left -text $data(-message) \

	    -background $bg

    if {[string compare $data(-icon) ""]} {

	if {([string equal [tk windowingsystem] "classic"]

		|| [string equal [tk windowingsystem] "aqua"])

		|| ([winfo depth $w] < 4) || $tk_strictMotif} {

	    label $w.bitmap -bitmap $data(-icon) -background $bg

	} else {

	    canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \

		    -background $bg

	    switch $data(-icon) {

		error {

		    $w.bitmap create oval 0 0 31 31 -fill red -outline black

		    $w.bitmap create line 9 9 23 23 -fill white -width 4

		    $w.bitmap create line 9 23 23 9 -fill white -width 4

		}

		info {

		    $w.bitmap create image 0 0 -anchor nw \

			    -image ::tk::dialog::b1

		    $w.bitmap create image 0 0 -anchor nw \

			    -image ::tk::dialog::b2

		    $w.bitmap create image 0 0 -anchor nw \

			    -image ::tk::dialog::i

		}

		question {

		    $w.bitmap create image 0 0 -anchor nw \

			    -image ::tk::dialog::b1

		    $w.bitmap create image 0 0 -anchor nw \

			    -image ::tk::dialog::b2

		    $w.bitmap create image 0 0 -anchor nw \

			    -image ::tk::dialog::q

		}

		default {

		    $w.bitmap create image 0 0 -anchor nw \

			    -image ::tk::dialog::w1

		    $w.bitmap create image 0 0 -anchor nw \

			    -image ::tk::dialog::w2

		    $w.bitmap create image 0 0 -anchor nw \

			    -image ::tk::dialog::w3

		}

	    }

	}

    }

    grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m

    grid columnconfigure $w.top 1 -weight 1

    grid rowconfigure $w.top 0 -weight 1

    # 5. Create a row of buttons at the bottom of the dialog.

    set i 0

    foreach but $buttons {

	set name [lindex $but 0]

	set opts [lrange $but 1 end]

	if {![llength $opts]} {

	    # Capitalize the first letter of $name

	    set capName [string toupper $name 0]

	    set opts [list -text $capName]

	}

	eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \

		[list -command [list set tk::Priv(button) $name]]

	if {[string equal $name $data(-default)]} {

	    $w.$name configure -default active

	} else {

	    $w.$name configure -default normal

	}

	grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew

	grid columnconfigure $w.bot $i -uniform buttons

        incr i

	# create the binding for the key accelerator, based on the underline

	#

        # set underIdx [$w.$name cget -under]

        # if {$underIdx >= 0} {

        #     set key [string index [$w.$name cget -text] $underIdx]

        #     bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]

        #     bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]

        # }

    }

    bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]

    if {[string compare {} $data(-default)]} {

	bind $w <FocusIn> {

	    if {[string equal Button [winfo class %W]]} {

		%W configure -default active

	    }

	}

	bind $w <FocusOut> {

	    if {[string equal Button [winfo class %W]]} {

		%W configure -default normal

	    }

	}

    }

    # 6. Create a binding for <Return> on the dialog

    bind $w <Return> {

	if {[string equal Button [winfo class %W]]} {

	    tk::ButtonInvoke %W

	}

    }

    # 7. Withdraw the window, then update all the geometry information

    # so we know how big it wants to be, then center the window in the

    # display and de-iconify it.

    ::tk::PlaceWindow $w widget $data(-parent)

    # 8. Set a grab and claim the focus too.

    if {[string compare $data(-default) ""]} {

	set focus $w.$data(-default)

    } else {

	set focus $w

    }

    ::tk::SetFocusGrab $w $focus

    # 9. Wait for the user to respond, then restore the focus and

    # return the index of the selected button.  Restore the focus

    # before deleting the window, since otherwise the window manager

    # may take the focus away so we can't redirect it.  Finally,

    # restore any grab that was in effect.

    vwait ::tk::Priv(button)

    ::tk::RestoreFocusGrab $w $focus

    return $Priv(button)

}