Bwidget Source Code
Artifact Content
Not logged in
Core Home Timeline Branches Tags Tickets Wiki Login
Check-ins Using Download Hex
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Artifact f9b1da92f3fdce55e6bf6da96b55c527e1704963db0526485fbda980a209aee3:

# ----------------------------------------------------------------------------
#  dialog.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: dialog.tcl,v 1.15.2.1 2010/08/04 13:07:59 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - Dialog::create
#     - Dialog::configure
#     - Dialog::cget
#     - Dialog::getframe
#     - Dialog::add
#     - Dialog::itemconfigure
#     - Dialog::itemcget
#     - Dialog::invoke
#     - Dialog::setfocus
#     - Dialog::enddialog
#     - Dialog::draw
#     - Dialog::withdraw
#     - Dialog::_destroy
# ----------------------------------------------------------------------------

# JDC: added -transient and -place flag

namespace eval Dialog {
    Widget::define Dialog dialog ButtonBox

    Widget::bwinclude Dialog ButtonBox .bbox \
	remove	   {-orient} \
	initialize {-spacing 10 -padx 10}

    Widget::declare Dialog {
	{-title	      String	 ""	  0}
	{-geometry    String	 ""	  0}
	{-modal	      Enum	 local	  0 {none local global}}
	{-bitmap      TkResource ""	  1 label}
	{-image	      TkResource ""	  1 label}
	{-separator   Boolean	 0	  1}
	{-cancel      Int	 -1	  0 "%d >= -1"}
	{-parent      String	 ""	  0}
	{-side	      Enum	 bottom	  1 {bottom left top right}}
	{-anchor      Enum	 c	  1 {n e w s c}}
	{-class	      String	 Dialog	  1}
	{-transient   Boolean	 1	  1}
	{-place	      Enum	 center	  0 {none center left right above below}}
    }

    Widget::addmap Dialog "" :cmd   {-background {}}
    Widget::addmap Dialog "" .frame {-background {}}

    bind BwDialog <Destroy> [list Dialog::_destroy %W]

    variable _widget
}


# ----------------------------------------------------------------------------
#  Command Dialog::create
# ----------------------------------------------------------------------------
proc Dialog::create { path args } {
    global   tcl_platform
    variable _widget

    array set maps [list Dialog {} .bbox {}]
    array set maps [Widget::parseArgs Dialog $args]

    # Check to see if the -class flag was specified
    set dialogClass "Dialog"
    array set dialogArgs $maps(Dialog)
    if { [info exists dialogArgs(-class)] } {
	set dialogClass $dialogArgs(-class)
    }

    if { [string equal $tcl_platform(platform) "unix"] } {
	set re raised
	set bd 1
    } else {
	set re flat
	set bd 0
    }
    toplevel $path -relief $re -borderwidth $bd -class $dialogClass
    wm withdraw $path

    Widget::initFromODB Dialog $path $maps(Dialog)

    bindtags $path [list $path BwDialog all]
    wm overrideredirect $path 1
    wm title $path [Widget::cget $path -title]
    set parent [Widget::cget $path -parent]
    if { ![winfo exists $parent] } {
        set parent [winfo parent $path]
    }
    # JDC: made transient optional
    if { [Widget::getoption $path -transient] } {
	wm transient $path [winfo toplevel $parent]
    }

    set side [Widget::cget $path -side]
    if { [string equal $side "left"] || [string equal $side "right"] } {
        set orient vertical
    } else {
        set orient horizontal
    }

    set bbox  [eval [list ButtonBox::create $path.bbox] $maps(.bbox) \
		   -orient $orient]
    set frame [frame $path.frame -relief flat -borderwidth 0]
    set bg [Widget::cget $path -background]
    $path configure -background $bg
    $frame configure -background $bg
    if { [set bitmap [Widget::getoption $path -image]] != "" } {
        set label [label $path.label -image $bitmap -background $bg]
    } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } {
        set label [label $path.label -bitmap $bitmap -background $bg]
    }
    if { [Widget::getoption $path -separator] } {
	Separator::create $path.sep -orient $orient -background $bg
    }
    set _widget($path,realized) 0
    set _widget($path,nbut)     0

    set cancel [Widget::getoption $path -cancel]
    bind $path <Escape>  [list ButtonBox::invoke $path.bbox $cancel]
    if {$cancel != -1} {
        wm protocol $path WM_DELETE_WINDOW [list ButtonBox::invoke $path.bbox $cancel]
    }
    bind $path <Return>  [list ButtonBox::invoke $path.bbox default]
    # Tk8.5 (TIP158) separated numeric keyboard enter and main keyboard
    # enter on Unix. So bind for both. This does not harm on Tk8.4 so no
    # check required. BWidget Ticket [3e31f04367].
    bind $path <KP_Enter>  [list ButtonBox::invoke $path.bbox default]

    return [Widget::create Dialog $path]
}


# ----------------------------------------------------------------------------
#  Command Dialog::configure
# ----------------------------------------------------------------------------
proc Dialog::configure { path args } {
    set res [Widget::configure $path $args]

    if { [Widget::hasChanged $path -title title] } {
        wm title $path $title
    }
    if { [Widget::hasChanged $path -background bg] } {
        if { [winfo exists $path.label] } {
            $path.label configure -background $bg
        }
        if { [winfo exists $path.sep] } {
            Separator::configure $path.sep -background $bg
        }
    }
    if { [Widget::hasChanged $path -cancel cancel] } {
        bind $path <Escape>  [list ButtonBox::invoke $path.bbox $cancel]
        if {$cancel == -1} {
            wm protocol $path WM_DELETE_WINDOW ""
        } else {
            wm protocol $path WM_DELETE_WINDOW [list ButtonBox::invoke $path.bbox $cancel]
        }
    }
    return $res
}


# ----------------------------------------------------------------------------
#  Command Dialog::cget
# ----------------------------------------------------------------------------
proc Dialog::cget { path option } {
    return [Widget::cget $path $option]
}


# ----------------------------------------------------------------------------
#  Command Dialog::getframe
# ----------------------------------------------------------------------------
proc Dialog::getframe { path } {
    return $path.frame
}


# ----------------------------------------------------------------------------
#  Command Dialog::add
# ----------------------------------------------------------------------------
proc Dialog::add { path args } {
    variable _widget

    if {[string equal $::tcl_platform(platform) "windows"]
	&& $::tk_version >= 8.4} {
	set width -11
    } else {
	set width 8
    }
    set cmd [list ButtonBox::add $path.bbox -width $width \
		 -command [list Dialog::enddialog $path $_widget($path,nbut)]]
    set res [eval $cmd $args]
    incr _widget($path,nbut)
    return $res
}


# ----------------------------------------------------------------------------
#  Command Dialog::itemconfigure
# ----------------------------------------------------------------------------
proc Dialog::itemconfigure { path index args } {
    return [eval [list ButtonBox::itemconfigure $path.bbox $index] $args]
}


# ----------------------------------------------------------------------------
#  Command Dialog::itemcget
# ----------------------------------------------------------------------------
proc Dialog::itemcget { path index option } {
    return [ButtonBox::itemcget $path.bbox $index $option]
}


# ----------------------------------------------------------------------------
#  Command Dialog::invoke
# ----------------------------------------------------------------------------
proc Dialog::invoke { path index } {
    ButtonBox::invoke $path.bbox $index
}


# ----------------------------------------------------------------------------
#  Command Dialog::setfocus
# ----------------------------------------------------------------------------
proc Dialog::setfocus { path index } {
    ButtonBox::setfocus $path.bbox $index
}


# ----------------------------------------------------------------------------
#  Command Dialog::enddialog
# ----------------------------------------------------------------------------
proc Dialog::enddialog { path result } {
    variable _widget

    set _widget($path,result) $result
}


# ----------------------------------------------------------------------------
#  Command Dialog::draw
# ----------------------------------------------------------------------------
proc Dialog::draw { path {focus ""} {overrideredirect 0} {geometry ""}} {
    variable _widget

    set parent [Widget::getoption $path -parent]
    if { !$_widget($path,realized) } {
        set _widget($path,realized) 1
        if { [llength [winfo children $path.bbox]] } {
            set side [Widget::getoption $path -side]
            if {[string equal $side "left"] || [string equal $side "right"]} {
                set pad  -padx
                set fill y
            } else {
                set pad  -pady
                set fill x
            }
            pack $path.bbox -side $side -padx 1m -pady 1m \
		-anchor [Widget::getoption $path -anchor]
            if { [winfo exists $path.sep] } {
                pack $path.sep -side $side -fill $fill $pad 2m
            }
        }
        if { [winfo exists $path.label] } {
            pack $path.label -side left -anchor n -padx 3m -pady 3m
        }
        pack $path.frame -padx 1m -pady 1m -fill both -expand yes
    }

    set geom [Widget::getMegawidgetOption $path -geometry]
    if { $geom != "" } {
	wm geometry $path $geom
    }

    if { [string equal $geometry ""] && ($geom == "") } {
	set place [Widget::getoption $path -place]
	if { ![string equal $place none] } {
	    if { [winfo exists $parent] } {
		BWidget::place $path 0 0 $place $parent
	    } else {
		BWidget::place $path 0 0 $place
	    }
	}
    } else {
	if { $geom != "" } {
	    wm geometry $path $geom
	} else {
	    wm geometry $path $geometry
	}
    }
    update idletasks
    wm overrideredirect $path $overrideredirect
    wm deiconify $path

    # patch by Bastien Chevreux ([email protected])
    # As seen on Windows systems *sigh*
    # When the toplevel is withdrawn, the tkwait command will wait forever.
    #  So, check that we are not withdrawn
    if {![winfo exists $parent] || \
	    ([wm state [winfo toplevel $parent]] != "withdrawn")} {
	tkwait visibility $path
    }
    BWidget::focus set $path
    if { [winfo exists $focus] } {
        focus -force $focus
    } else {
        ButtonBox::setfocus $path.bbox default
    }

    if { [set grab [Widget::cget $path -modal]] != "none" } {
        BWidget::grab $grab $path
        if {[info exists _widget($path,result)]} { 
            unset _widget($path,result)
        }
        tkwait variable Dialog::_widget($path,result)
        if { [info exists _widget($path,result)] } {
            set res $_widget($path,result)
            unset _widget($path,result)
        } else {
            set res -1
        }
        withdraw $path
        return $res
    }
    return ""
}


# ----------------------------------------------------------------------------
#  Command Dialog::withdraw
# ----------------------------------------------------------------------------
proc Dialog::withdraw { path } {
    BWidget::grab release $path
    BWidget::focus release $path
    if { [winfo exists $path] } {
        wm withdraw $path
    }
}


# ----------------------------------------------------------------------------
#  Command Dialog::_destroy
# ----------------------------------------------------------------------------
proc Dialog::_destroy { path } {
    variable _widget

    Dialog::enddialog $path -1

    BWidget::grab  release $path
    BWidget::focus release $path
    if {[info exists _widget($path,result)]} {
        unset _widget($path,result)
    }
    unset _widget($path,realized)
    unset _widget($path,nbut)

    Widget::destroy $path
}
This page was generated in about 0.009s by Fossil 2.9 [0fd79a3e09] 2019-07-13 13:05:19