share/tk8.4/tk.tcl - toolchains/skids - Git at Google

 # tk.tcl --
 #
 # Initialization script normally executed in the interpreter for each
 # Tk-based application.  Arranges class bindings for widgets.
 #
 # RCS: @(#) $Id: tk.tcl,v 1.45 2002/10/10 16:34:51 hobbs Exp $
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-2000 Ajuba Solutions.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 # Insist on running with compatible versions of Tcl and Tk.
 package require -exact Tk 8.4
 package require -exact Tcl 8.4

 # Create a ::tk namespace
 namespace eval ::tk {
     # Set up the msgcat commands
     namespace eval msgcat {
 	namespace export mc mcmax
         if {[interp issafe] || [catch {package require msgcat}]} {
             # The msgcat package is not available.  Supply our own
             # minimal replacement.
             proc mc {src args} {
                 return [eval [list format $src] $args]
             }
             proc mcmax {args} {
                 set max 0
                 foreach string $args {
                     set len [string length $string]
                     if {$len>$max} {
                         set max $len
                     }
                 }
                 return $max
             }
         } else {
             # Get the commands from the msgcat package that Tk uses.
             namespace import ::msgcat::mc
             namespace import ::msgcat::mcmax
             ::msgcat::mcload [file join $::tk_library msgs]
         }
     }
     namespace import ::tk::msgcat::*
 }

 # Add Tk's directory to the end of the auto-load search path, if it
 # isn't already on the path:

 if {[info exists ::auto_path] && [string compare {} $::tk_library] && \
 	[lsearch -exact $::auto_path $::tk_library] < 0} {
     lappend ::auto_path $::tk_library
 }

 # Turn off strict Motif look and feel as a default.

 set ::tk_strictMotif 0

 # Turn on useinputmethods (X Input Methods) by default.
 # We catch this because safe interpreters may not allow the call.

 catch {tk useinputmethods 1}

 # ::tk::PlaceWindow --
 #   place a toplevel at a particular position
 # Arguments:
 #   toplevel	name of toplevel window
 #   ?placement?	pointer ?center? ; places $w centered on the pointer
 #		widget widgetPath ; centers $w over widget_name
 #		defaults to placing toplevel in the middle of the screen
 #   ?anchor?	center or widgetPath
 # Results:
 #   Returns nothing
 #
 proc ::tk::PlaceWindow {w {place ""} {anchor ""}} {
     wm withdraw $w
     update idletasks
     set checkBounds 1
     if {[string equal -len [string length $place] $place "pointer"]} {
 	## place at POINTER (centered if $anchor == center)
 	if {[string equal -len [string length $anchor] $anchor "center"]} {
 	    set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]
 	    set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]
 	} else {
 	    set x [winfo pointerx $w]
 	    set y [winfo pointery $w]
 	}
     } elseif {[string equal -len [string length $place] $place "widget"] && \
 	    [winfo exists $anchor] && [winfo ismapped $anchor]} {
 	## center about WIDGET $anchor, widget must be mapped
 	set x [expr {[winfo rootx $anchor] + \
 		([winfo width $anchor]-[winfo reqwidth $w])/2}]
 	set y [expr {[winfo rooty $anchor] + \
 		([winfo height $anchor]-[winfo reqheight $w])/2}]
     } else {
 	set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
 	set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
 	set checkBounds 0
     }
     if {$checkBounds} {
 	if {$x < 0} {
 	    set x 0
 	} elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {
 	    set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]
 	}
 	if {$y < 0} {
 	    set y 0
 	} elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {
 	    set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]
 	}
 	if {[tk windowingsystem] eq "macintosh" \
 		|| [tk windowingsystem] eq "aqua"} {
 	    # Avoid the native menu bar which sits on top of everything.
 	    if {$y < 20} { set y 20 }
 	}
     }
     wm geometry $w +$x+$y
     wm deiconify $w
 }

 # ::tk::SetFocusGrab --
 #   swap out current focus and grab temporarily (for dialogs)
 # Arguments:
 #   grab	new window to grab
 #   focus	window to give focus to
 # Results:
 #   Returns nothing
 #
 proc ::tk::SetFocusGrab {grab {focus {}}} {
     set index "$grab,$focus"
     upvar ::tk::FocusGrab($index) data

     lappend data [focus]
     set oldGrab [grab current $grab]
     lappend data $oldGrab
     if {[winfo exists $oldGrab]} {
 	lappend data [grab status $oldGrab]
     }
     # The "grab" command will fail if another application
     # already holds the grab.  So catch it.
     catch {grab $grab}
     if {[winfo exists $focus]} {
 	focus $focus
     }
 }

 # ::tk::RestoreFocusGrab --
 #   restore old focus and grab (for dialogs)
 # Arguments:
 #   grab	window that had taken grab
 #   focus	window that had taken focus
 #   destroy	destroy|withdraw - how to handle the old grabbed window
 # Results:
 #   Returns nothing
 #
 proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {
     set index "$grab,$focus"
     if {[info exists ::tk::FocusGrab($index)]} {
 	foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }
 	unset ::tk::FocusGrab($index)
     } else {
 	set oldGrab ""
     }

     catch {focus $oldFocus}
     grab release $grab
     if {[string equal $destroy "withdraw"]} {
 	wm withdraw $grab
     } else {
 	destroy $grab
     }
     if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {
 	if {[string equal $oldStatus "global"]} {
 	    grab -global $oldGrab
 	} else {
 	    grab $oldGrab
 	}
     }
 }

 # ::tk::GetSelection --
 #   This tries to obtain the default selection.  On Unix, we first try
 #   and get a UTF8_STRING, a type supported by modern Unix apps for
 #   passing Unicode data safely.  We fall back on the default STRING
 #   type otherwise.  On Windows, only the STRING type is necessary.
 # Arguments:
 #   w	The widget for which the selection will be retrieved.
 #	Important for the -displayof property.
 #   sel	The source of the selection (PRIMARY or CLIPBOARD)
 # Results:
 #   Returns the selection, or an error if none could be found
 #
 if {[string equal $tcl_platform(platform) "unix"]} {
     proc ::tk::GetSelection {w {sel PRIMARY}} {
 	if {[catch {selection get -displayof $w -selection $sel \
 		-type UTF8_STRING} txt] \
 		&& [catch {selection get -displayof $w -selection $sel} txt]} {
 	    return -code error "could not find default selection"
 	} else {
 	    return $txt
 	}
     }
 } else {
     proc ::tk::GetSelection {w {sel PRIMARY}} {
 	if {[catch {selection get -displayof $w -selection $sel} txt]} {
 	    return -code error "could not find default selection"
 	} else {
 	    return $txt
 	}
     }
 }

 # ::tk::ScreenChanged --
 # This procedure is invoked by the binding mechanism whenever the
 # "current" screen is changing.  The procedure does two things.
 # First, it uses "upvar" to make variable "::tk::Priv" point at an
 # array variable that holds state for the current display.  Second,
 # it initializes the array if it didn't already exist.
 #
 # Arguments:
 # screen -		The name of the new screen.

 proc ::tk::ScreenChanged screen {
     set x [string last . $screen]
     if {$x > 0} {
 	set disp [string range $screen 0 [expr {$x - 1}]]
     } else {
 	set disp $screen
     }

     uplevel #0 upvar #0 ::tk::Priv.$disp ::tk::Priv
     variable ::tk::Priv
     global tcl_platform

     if {[info exists Priv]} {
 	set Priv(screen) $screen
 	return
     }
     array set Priv {
 	activeMenu	{}
 	activeItem	{}
 	afterId		{}
 	buttons		0
 	buttonWindow	{}
 	dragging	0
 	focus		{}
 	grab		{}
 	initPos		{}
 	inMenubutton	{}
 	listboxPrev	{}
 	menuBar		{}
 	mouseMoved	0
 	oldGrab		{}
 	popup		{}
 	postedMb	{}
 	pressX		0
 	pressY		0
 	prevPos		0
 	selectMode	char
     }
     set Priv(screen) $screen
     set Priv(tearoff) [string equal [tk windowingsystem] "x11"]
     set Priv(window) {}
 }

 # Do initial setup for Priv, so that it is always bound to something
 # (otherwise, if someone references it, it may get set to a non-upvar-ed
 # value, which will cause trouble later).

 tk::ScreenChanged [winfo screen .]

 # ::tk::EventMotifBindings --
 # This procedure is invoked as a trace whenever ::tk_strictMotif is
 # changed.  It is used to turn on or turn off the motif virtual
 # bindings.
 #
 # Arguments:
 # n1 - the name of the variable being changed ("::tk_strictMotif").

 proc ::tk::EventMotifBindings {n1 dummy dummy} {
     upvar $n1 name

     if {$name} {
 	set op delete
     } else {
 	set op add
     }

     event $op <<Cut>> <Control-Key-w>
     event $op <<Copy>> <Meta-Key-w>
     event $op <<Paste>> <Control-Key-y>
     event $op <<Undo>> <Control-underscore>
 }

 #----------------------------------------------------------------------
 # Define common dialogs on platforms where they are not implemented
 # using compiled code.
 #----------------------------------------------------------------------

 if {[string equal [info commands tk_chooseColor] ""]} {
     proc ::tk_chooseColor {args} {
 	return [eval tk::dialog::color:: $args]
     }
 }
 if {[string equal [info commands tk_getOpenFile] ""]} {
     proc ::tk_getOpenFile {args} {
 	if {$::tk_strictMotif} {
 	    return [eval tk::MotifFDialog open $args]
 	} else {
 	    return [eval ::tk::dialog::file:: open $args]
 	}
     }
 }
 if {[string equal [info commands tk_getSaveFile] ""]} {
     proc ::tk_getSaveFile {args} {
 	if {$::tk_strictMotif} {
 	    return [eval tk::MotifFDialog save $args]
 	} else {
 	    return [eval ::tk::dialog::file:: save $args]
 	}
     }
 }
 if {[string equal [info commands tk_messageBox] ""]} {
     proc ::tk_messageBox {args} {
 	return [eval tk::MessageBox $args]
     }
 }
 if {[string equal [info command tk_chooseDirectory] ""]} {
     proc ::tk_chooseDirectory {args} {
 	return [eval ::tk::dialog::file::chooseDir:: $args]
     }
 }

 #----------------------------------------------------------------------
 # Define the set of common virtual events.
 #----------------------------------------------------------------------

 switch [tk windowingsystem] {
     "x11" {
 	event add <<Cut>> <Control-Key-x> <Key-F20>
 	event add <<Copy>> <Control-Key-c> <Key-F16>
 	event add <<Paste>> <Control-Key-v> <Key-F18>
 	event add <<PasteSelection>> <ButtonRelease-2>
 	event add <<Undo>> <Control-Key-z>
 	event add <<Redo>> <Control-Key-Z>
 	# Some OS's define a goofy (as in, not <Shift-Tab>) keysym
 	# that is returned when the user presses <Shift-Tab>.  In order for
 	# tab traversal to work, we have to add these keysyms to the
 	# PrevWindow event.
 	# We use catch just in case the keysym isn't recognized.
 	# This is needed for XFree86 systems
 	catch { event add <<PrevWindow>> <ISO_Left_Tab> }
 	# This seems to be correct on *some* HP systems.
 	catch { event add <<PrevWindow>> <hpBackTab> }

 	trace variable ::tk_strictMotif w ::tk::EventMotifBindings
 	set ::tk_strictMotif $::tk_strictMotif
     }
     "win32" {
 	event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>
 	event add <<Copy>> <Control-Key-c> <Control-Key-Insert>
 	event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>
 	event add <<PasteSelection>> <ButtonRelease-2>
   	event add <<Undo>> <Control-Key-z>
 	event add <<Redo>> <Control-Key-y>
     }
     "aqua" {
 	event add <<Cut>> <Command-Key-x> <Key-F2>
 	event add <<Copy>> <Command-Key-c> <Key-F3>
 	event add <<Paste>> <Command-Key-v> <Key-F4>
 	event add <<PasteSelection>> <ButtonRelease-2>
 	event add <<Clear>> <Clear>
   	event add <<Undo>> <Command-Key-z>
 	event add <<Redo>> <Command-Key-y>
     }
     "classic" {
 	event add <<Cut>> <Control-Key-x> <Key-F2>
 	event add <<Copy>> <Control-Key-c> <Key-F3>
 	event add <<Paste>> <Control-Key-v> <Key-F4>
 	event add <<PasteSelection>> <ButtonRelease-2>
 	event add <<Clear>> <Clear>
 	event add <<Undo>> <Control-Key-z> <Key-F1>
 	event add <<Redo>> <Control-Key-Z>
     }
 }
 # ----------------------------------------------------------------------
 # Read in files that define all of the class bindings.
 # ----------------------------------------------------------------------

 if {$::tk_library ne ""} {
     if {[string equal $tcl_platform(platform) "macintosh"]} {
 	proc ::tk::SourceLibFile {file} {
 	    if {[catch {
 		namespace eval :: \
 			[list source [file join $::tk_library $file.tcl]]
 	    }]} {
 		namespace eval :: [list source -rsrc $file]
 	    }
 	}
     } else {
 	proc ::tk::SourceLibFile {file} {
 	    namespace eval :: [list source [file join $::tk_library $file.tcl]]
 	}
     }
     namespace eval ::tk {
 	SourceLibFile button
 	SourceLibFile entry
 	SourceLibFile listbox
 	SourceLibFile menu
 	SourceLibFile panedwindow
 	SourceLibFile scale
 	SourceLibFile scrlbar
 	SourceLibFile spinbox
 	SourceLibFile text
     }
 }
 # ----------------------------------------------------------------------
 # Default bindings for keyboard traversal.
 # ----------------------------------------------------------------------

 event add <<PrevWindow>> <Shift-Tab>
 bind all <Tab> {tk::TabToWindow [tk_focusNext %W]}
 bind all <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}

 # ::tk::CancelRepeat --
 # This procedure is invoked to cancel an auto-repeat action described
 # by ::tk::Priv(afterId).  It's used by several widgets to auto-scroll
 # the widget when the mouse is dragged out of the widget with a
 # button pressed.
 #
 # Arguments:
 # None.

 proc ::tk::CancelRepeat {} {
     variable ::tk::Priv
     after cancel $Priv(afterId)
     set Priv(afterId) {}
 }

 # ::tk::TabToWindow --
 # This procedure moves the focus to the given widget.  If the widget
 # is an entry, it selects the entire contents of the widget.
 #
 # Arguments:
 # w - Window to which focus should be set.

 proc ::tk::TabToWindow {w} {
     if {[string equal [winfo class $w] Entry]} {
 	$w selection range 0 end
 	$w icursor end
     }
     focus $w
 }

 # ::tk::UnderlineAmpersand --
 # This procedure takes some text with ampersand and returns
 # text w/o ampersand and position of the ampersand.
 # Double ampersands are converted to single ones.
 # Position returned is -1 when there is no ampersand.
 #
 proc ::tk::UnderlineAmpersand {text} {
     set idx [string first "&" $text]
     if {$idx >= 0} {
 	set underline $idx
 	# ignore "&&"
 	while {[string match "&" [string index $text [expr {$idx + 1}]]]} {
 	    set base [expr {$idx + 2}]
 	    set idx  [string first "&" [string range $text $base end]]
 	    if {$idx < 0} {
 		break
 	    } else {
 		set underline [expr {$underline + $idx + 1}]
 		incr idx $base
 	    }
 	}
     }
     if {$idx >= 0} {
 	regsub -all -- {&([^&])} $text {\1} text
     }
     return [list $text $idx]
 }

 # ::tk::SetAmpText --
 # Given widget path and text with "magic ampersands",
 # sets -text and -underline options for the widget
 #
 proc ::tk::SetAmpText {widget text} {
     foreach {newtext under} [::tk::UnderlineAmpersand $text] {
 	$widget configure -text $newtext -underline $under
     }
 }

 # ::tk::AmpWidget --
 # Creates new widget, turning -text option into -text and
 # -underline options, returned by ::tk::UnderlineAmpersand.
 #
 proc ::tk::AmpWidget {class path args} {
     set wcmd [list $class $path]
     foreach {opt val} $args {
 	if {[string equal $opt {-text}]} {
 	    foreach {newtext under} [::tk::UnderlineAmpersand $val] {
 		lappend wcmd -text $newtext -underline $under
 	    }
 	} else {
 	    lappend wcmd $opt $val
 	}
     }
     eval $wcmd
     if {$class=="button"} {
 	bind $path <<AltUnderlined>> [list $path invoke]
     }
     return $path
 }

 # ::tk::FindAltKeyTarget --
 # search recursively through the hierarchy of visible widgets
 # to find button or label which has $char as underlined character
 #
 proc ::tk::FindAltKeyTarget {path char} {
     switch [winfo class $path] {
 	Button -
 	Label {
 	    if {[string equal -nocase $char \
 		[string index [$path cget -text] \
 		[$path cget -underline]]]} {return $path} else {return {}}
 	}
 	default {
 	    foreach child \
 		[concat [grid slaves $path] \
 		[pack slaves $path] \
 		[place slaves $path] ] {
 		if {""!=[set target [::tk::FindAltKeyTarget $child $char]]} {
 		    return $target
 		}
 	    }
 	}
     }
     return {}
 }

 # ::tk::AltKeyInDialog --
 # <Alt-Key> event handler for standard dialogs. Sends <<AltUnderlined>>
 # to button or label which has appropriate underlined character
 #
 proc ::tk::AltKeyInDialog {path key} {
     set target [::tk::FindAltKeyTarget $path $key]
     if { $target == ""} return
     event generate $target <<AltUnderlined>>
 }

 # ::tk::mcmaxamp --
 # Replacement for mcmax, used for texts with "magic ampersand" in it.
 #

 proc ::tk::mcmaxamp {args} {
     set maxlen 0
     foreach arg $args {
 	set length [string length [lindex [::tk::UnderlineAmpersand [mc $arg]] 0]]
 	if {$length>$maxlen} {
 	    set maxlen $length
 	}
     }
     return $maxlen
 }
 # For now, turn off the custom mdef proc for the mac:

 if {[string equal [tk windowingsystem] "aqua"]} {
     namespace eval ::tk::mac {
 	set useCustomMDEF 0
     }
 }
	# tk.tcl --
	#
	# Initialization script normally executed in the interpreter for each
	# Tk-based application. Arranges class bindings for widgets.
	#
	# RCS: @(#) $Id: tk.tcl,v 1.45 2002/10/10 16:34:51 hobbs Exp $
	#
	# Copyright (c) 1992-1994 The Regents of the University of California.
	# Copyright (c) 1994-1996 Sun Microsystems, Inc.
	# Copyright (c) 1998-2000 Ajuba Solutions.
	#
	# See the file "license.terms" for information on usage and redistribution
	# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

	# Insist on running with compatible versions of Tcl and Tk.
	package require -exact Tk 8.4
	package require -exact Tcl 8.4

	# Create a ::tk namespace
	namespace eval ::tk {
	# Set up the msgcat commands
	namespace eval msgcat {
	namespace export mc mcmax
	if {[interp issafe] \|\| [catch {package require msgcat}]} {
	# The msgcat package is not available. Supply our own
	# minimal replacement.
	proc mc {src args} {
	return [eval [list format $src] $args]
	}
	proc mcmax {args} {
	set max 0
	foreach string $args {
	set len [string length $string]
	if {$len>$max} {
	set max $len
	}
	}
	return $max
	}
	} else {
	# Get the commands from the msgcat package that Tk uses.
	namespace import ::msgcat::mc
	namespace import ::msgcat::mcmax
	::msgcat::mcload [file join $::tk_library msgs]
	}
	}
	namespace import ::tk::msgcat::*
	}

	# Add Tk's directory to the end of the auto-load search path, if it
	# isn't already on the path:

	if {[info exists ::auto_path] && [string compare {} $::tk_library] && \
	[lsearch -exact $::auto_path $::tk_library] < 0} {
	lappend ::auto_path $::tk_library
	}

	# Turn off strict Motif look and feel as a default.

	set ::tk_strictMotif 0

	# Turn on useinputmethods (X Input Methods) by default.
	# We catch this because safe interpreters may not allow the call.

	catch {tk useinputmethods 1}

	# ::tk::PlaceWindow --
	# place a toplevel at a particular position
	# Arguments:
	# toplevel name of toplevel window
	# ?placement? pointer ?center? ; places $w centered on the pointer
	# widget widgetPath ; centers $w over widget_name
	# defaults to placing toplevel in the middle of the screen
	# ?anchor? center or widgetPath
	# Results:
	# Returns nothing
	#
	proc ::tk::PlaceWindow {w {place ""} {anchor ""}} {
	wm withdraw $w
	update idletasks
	set checkBounds 1
	if {[string equal -len [string length $place] $place "pointer"]} {
	## place at POINTER (centered if $anchor == center)
	if {[string equal -len [string length $anchor] $anchor "center"]} {
	set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]
	set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]
	} else {
	set x [winfo pointerx $w]
	set y [winfo pointery $w]
	}
	} elseif {[string equal -len [string length $place] $place "widget"] && \
	[winfo exists $anchor] && [winfo ismapped $anchor]} {
	## center about WIDGET $anchor, widget must be mapped
	set x [expr {[winfo rootx $anchor] + \
	([winfo width $anchor]-[winfo reqwidth $w])/2}]
	set y [expr {[winfo rooty $anchor] + \
	([winfo height $anchor]-[winfo reqheight $w])/2}]
	} else {
	set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
	set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
	set checkBounds 0
	}
	if {$checkBounds} {
	if {$x < 0} {
	set x 0
	} elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {
	set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]
	}
	if {$y < 0} {
	set y 0
	} elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {
	set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]
	}
	if {[tk windowingsystem] eq "macintosh" \
	\|\| [tk windowingsystem] eq "aqua"} {
	# Avoid the native menu bar which sits on top of everything.
	if {$y < 20} { set y 20 }
	}
	}
	wm geometry $w +$x+$y
	wm deiconify $w
	}

	# ::tk::SetFocusGrab --
	# swap out current focus and grab temporarily (for dialogs)
	# Arguments:
	# grab new window to grab
	# focus window to give focus to
	# Results:
	# Returns nothing
	#
	proc ::tk::SetFocusGrab {grab {focus {}}} {
	set index "$grab,$focus"
	upvar ::tk::FocusGrab($index) data

	lappend data [focus]
	set oldGrab [grab current $grab]
	lappend data $oldGrab
	if {[winfo exists $oldGrab]} {
	lappend data [grab status $oldGrab]
	}
	# The "grab" command will fail if another application
	# already holds the grab. So catch it.
	catch {grab $grab}
	if {[winfo exists $focus]} {
	focus $focus
	}
	}

	# ::tk::RestoreFocusGrab --
	# restore old focus and grab (for dialogs)
	# Arguments:
	# grab window that had taken grab
	# focus window that had taken focus
	# destroy destroy\|withdraw - how to handle the old grabbed window
	# Results:
	# Returns nothing
	#
	proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {
	set index "$grab,$focus"
	if {[info exists ::tk::FocusGrab($index)]} {
	foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }
	unset ::tk::FocusGrab($index)
	} else {
	set oldGrab ""
	}

	catch {focus $oldFocus}
	grab release $grab
	if {[string equal $destroy "withdraw"]} {
	wm withdraw $grab
	} else {
	destroy $grab
	}
	if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {
	if {[string equal $oldStatus "global"]} {
	grab -global $oldGrab
	} else {
	grab $oldGrab
	}
	}
	}

	# ::tk::GetSelection --
	# This tries to obtain the default selection. On Unix, we first try
	# and get a UTF8_STRING, a type supported by modern Unix apps for
	# passing Unicode data safely. We fall back on the default STRING
	# type otherwise. On Windows, only the STRING type is necessary.
	# Arguments:
	# w The widget for which the selection will be retrieved.
	# Important for the -displayof property.
	# sel The source of the selection (PRIMARY or CLIPBOARD)
	# Results:
	# Returns the selection, or an error if none could be found
	#
	if {[string equal $tcl_platform(platform) "unix"]} {
	proc ::tk::GetSelection {w {sel PRIMARY}} {
	if {[catch {selection get -displayof $w -selection $sel \
	-type UTF8_STRING} txt] \
	&& [catch {selection get -displayof $w -selection $sel} txt]} {
	return -code error "could not find default selection"
	} else {
	return $txt
	}
	}
	} else {
	proc ::tk::GetSelection {w {sel PRIMARY}} {
	if {[catch {selection get -displayof $w -selection $sel} txt]} {
	return -code error "could not find default selection"
	} else {
	return $txt
	}
	}
	}

	# ::tk::ScreenChanged --
	# This procedure is invoked by the binding mechanism whenever the
	# "current" screen is changing. The procedure does two things.
	# First, it uses "upvar" to make variable "::tk::Priv" point at an
	# array variable that holds state for the current display. Second,
	# it initializes the array if it didn't already exist.
	#
	# Arguments:
	# screen - The name of the new screen.

	proc ::tk::ScreenChanged screen {
	set x [string last . $screen]
	if {$x > 0} {
	set disp [string range $screen 0 [expr {$x - 1}]]
	} else {
	set disp $screen
	}

	uplevel #0 upvar #0 ::tk::Priv.$disp ::tk::Priv
	variable ::tk::Priv
	global tcl_platform

	if {[info exists Priv]} {
	set Priv(screen) $screen
	return
	}
	array set Priv {
	activeMenu {}
	activeItem {}
	afterId {}
	buttons 0
	buttonWindow {}
	dragging 0
	focus {}
	grab {}
	initPos {}
	inMenubutton {}
	listboxPrev {}
	menuBar {}
	mouseMoved 0
	oldGrab {}
	popup {}
	postedMb {}
	pressX 0
	pressY 0
	prevPos 0
	selectMode char
	}
	set Priv(screen) $screen
	set Priv(tearoff) [string equal [tk windowingsystem] "x11"]
	set Priv(window) {}
	}

	# Do initial setup for Priv, so that it is always bound to something
	# (otherwise, if someone references it, it may get set to a non-upvar-ed
	# value, which will cause trouble later).

	tk::ScreenChanged [winfo screen .]

	# ::tk::EventMotifBindings --
	# This procedure is invoked as a trace whenever ::tk_strictMotif is
	# changed. It is used to turn on or turn off the motif virtual
	# bindings.
	#
	# Arguments:
	# n1 - the name of the variable being changed ("::tk_strictMotif").

	proc ::tk::EventMotifBindings {n1 dummy dummy} {
	upvar $n1 name

	if {$name} {
	set op delete
	} else {
	set op add
	}

	event $op <<Cut>> <Control-Key-w>
	event $op <<Copy>> <Meta-Key-w>
	event $op <<Paste>> <Control-Key-y>
	event $op <<Undo>> <Control-underscore>
	}

	#----------------------------------------------------------------------
	# Define common dialogs on platforms where they are not implemented
	# using compiled code.
	#----------------------------------------------------------------------

	if {[string equal [info commands tk_chooseColor] ""]} {
	proc ::tk_chooseColor {args} {
	return [eval tk::dialog::color:: $args]
	}
	}
	if {[string equal [info commands tk_getOpenFile] ""]} {
	proc ::tk_getOpenFile {args} {
	if {$::tk_strictMotif} {
	return [eval tk::MotifFDialog open $args]
	} else {
	return [eval ::tk::dialog::file:: open $args]
	}
	}
	}
	if {[string equal [info commands tk_getSaveFile] ""]} {
	proc ::tk_getSaveFile {args} {
	if {$::tk_strictMotif} {
	return [eval tk::MotifFDialog save $args]
	} else {
	return [eval ::tk::dialog::file:: save $args]
	}
	}
	}
	if {[string equal [info commands tk_messageBox] ""]} {
	proc ::tk_messageBox {args} {
	return [eval tk::MessageBox $args]
	}
	}
	if {[string equal [info command tk_chooseDirectory] ""]} {
	proc ::tk_chooseDirectory {args} {
	return [eval ::tk::dialog::file::chooseDir:: $args]
	}
	}

	#----------------------------------------------------------------------
	# Define the set of common virtual events.
	#----------------------------------------------------------------------

	switch [tk windowingsystem] {
	"x11" {
	event add <<Cut>> <Control-Key-x> <Key-F20>
	event add <<Copy>> <Control-Key-c> <Key-F16>
	event add <<Paste>> <Control-Key-v> <Key-F18>
	event add <<PasteSelection>> <ButtonRelease-2>
	event add <<Undo>> <Control-Key-z>
	event add <<Redo>> <Control-Key-Z>
	# Some OS's define a goofy (as in, not <Shift-Tab>) keysym
	# that is returned when the user presses <Shift-Tab>. In order for
	# tab traversal to work, we have to add these keysyms to the
	# PrevWindow event.
	# We use catch just in case the keysym isn't recognized.
	# This is needed for XFree86 systems
	catch { event add <<PrevWindow>> <ISO_Left_Tab> }
	# This seems to be correct on some HP systems.
	catch { event add <<PrevWindow>> <hpBackTab> }

	trace variable ::tk_strictMotif w ::tk::EventMotifBindings
	set ::tk_strictMotif $::tk_strictMotif
	}
	"win32" {
	event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>
	event add <<Copy>> <Control-Key-c> <Control-Key-Insert>
	event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>
	event add <<PasteSelection>> <ButtonRelease-2>
	event add <<Undo>> <Control-Key-z>
	event add <<Redo>> <Control-Key-y>
	}
	"aqua" {
	event add <<Cut>> <Command-Key-x> <Key-F2>
	event add <<Copy>> <Command-Key-c> <Key-F3>
	event add <<Paste>> <Command-Key-v> <Key-F4>
	event add <<PasteSelection>> <ButtonRelease-2>
	event add <<Clear>> <Clear>
	event add <<Undo>> <Command-Key-z>
	event add <<Redo>> <Command-Key-y>
	}
	"classic" {
	event add <<Cut>> <Control-Key-x> <Key-F2>
	event add <<Copy>> <Control-Key-c> <Key-F3>
	event add <<Paste>> <Control-Key-v> <Key-F4>
	event add <<PasteSelection>> <ButtonRelease-2>
	event add <<Clear>> <Clear>
	event add <<Undo>> <Control-Key-z> <Key-F1>
	event add <<Redo>> <Control-Key-Z>
	}
	}
	# ----------------------------------------------------------------------
	# Read in files that define all of the class bindings.
	# ----------------------------------------------------------------------

	if {$::tk_library ne ""} {
	if {[string equal $tcl_platform(platform) "macintosh"]} {
	proc ::tk::SourceLibFile {file} {
	if {[catch {
	namespace eval :: \
	[list source [file join $::tk_library $file.tcl]]
	}]} {
	namespace eval :: [list source -rsrc $file]
	}
	}
	} else {
	proc ::tk::SourceLibFile {file} {
	namespace eval :: [list source [file join $::tk_library $file.tcl]]
	}
	}
	namespace eval ::tk {
	SourceLibFile button
	SourceLibFile entry
	SourceLibFile listbox
	SourceLibFile menu
	SourceLibFile panedwindow
	SourceLibFile scale
	SourceLibFile scrlbar
	SourceLibFile spinbox
	SourceLibFile text
	}
	}
	# ----------------------------------------------------------------------
	# Default bindings for keyboard traversal.
	# ----------------------------------------------------------------------

	event add <<PrevWindow>> <Shift-Tab>
	bind all <Tab> {tk::TabToWindow [tk_focusNext %W]}
	bind all <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}

	# ::tk::CancelRepeat --
	# This procedure is invoked to cancel an auto-repeat action described
	# by ::tk::Priv(afterId). It's used by several widgets to auto-scroll
	# the widget when the mouse is dragged out of the widget with a
	# button pressed.
	#
	# Arguments:
	# None.

	proc ::tk::CancelRepeat {} {
	variable ::tk::Priv
	after cancel $Priv(afterId)
	set Priv(afterId) {}
	}

	# ::tk::TabToWindow --
	# This procedure moves the focus to the given widget. If the widget
	# is an entry, it selects the entire contents of the widget.
	#
	# Arguments:
	# w - Window to which focus should be set.

	proc ::tk::TabToWindow {w} {
	if {[string equal [winfo class $w] Entry]} {
	$w selection range 0 end
	$w icursor end
	}
	focus $w
	}

	# ::tk::UnderlineAmpersand --
	# This procedure takes some text with ampersand and returns
	# text w/o ampersand and position of the ampersand.
	# Double ampersands are converted to single ones.
	# Position returned is -1 when there is no ampersand.
	#
	proc ::tk::UnderlineAmpersand {text} {
	set idx [string first "&" $text]
	if {$idx >= 0} {
	set underline $idx
	# ignore "&&"
	while {[string match "&" [string index $text [expr {$idx + 1}]]]} {
	set base [expr {$idx + 2}]
	set idx [string first "&" [string range $text $base end]]
	if {$idx < 0} {
	break
	} else {
	set underline [expr {$underline + $idx + 1}]
	incr idx $base
	}
	}
	}
	if {$idx >= 0} {
	regsub -all -- {&([^&])} $text {\1} text
	}
	return [list $text $idx]
	}

	# ::tk::SetAmpText --
	# Given widget path and text with "magic ampersands",
	# sets -text and -underline options for the widget
	#
	proc ::tk::SetAmpText {widget text} {
	foreach {newtext under} [::tk::UnderlineAmpersand $text] {
	$widget configure -text $newtext -underline $under
	}
	}

	# ::tk::AmpWidget --
	# Creates new widget, turning -text option into -text and
	# -underline options, returned by ::tk::UnderlineAmpersand.
	#
	proc ::tk::AmpWidget {class path args} {
	set wcmd [list $class $path]
	foreach {opt val} $args {
	if {[string equal $opt {-text}]} {
	foreach {newtext under} [::tk::UnderlineAmpersand $val] {
	lappend wcmd -text $newtext -underline $under
	}
	} else {
	lappend wcmd $opt $val
	}
	}
	eval $wcmd
	if {$class=="button"} {
	bind $path <<AltUnderlined>> [list $path invoke]
	}
	return $path
	}

	# ::tk::FindAltKeyTarget --
	# search recursively through the hierarchy of visible widgets
	# to find button or label which has $char as underlined character
	#
	proc ::tk::FindAltKeyTarget {path char} {
	switch [winfo class $path] {
	Button -
	Label {
	if {[string equal -nocase $char \
	[string index [$path cget -text] \
	[$path cget -underline]]]} {return $path} else {return {}}
	}
	default {
	foreach child \
	[concat [grid slaves $path] \
	[pack slaves $path] \
	[place slaves $path] ] {
	if {""!=[set target [::tk::FindAltKeyTarget $child $char]]} {
	return $target
	}
	}
	}
	}
	return {}
	}

	# ::tk::AltKeyInDialog --
	# <Alt-Key> event handler for standard dialogs. Sends <<AltUnderlined>>
	# to button or label which has appropriate underlined character
	#
	proc ::tk::AltKeyInDialog {path key} {
	set target [::tk::FindAltKeyTarget $path $key]
	if { $target == ""} return
	event generate $target <<AltUnderlined>>
	}

	# ::tk::mcmaxamp --
	# Replacement for mcmax, used for texts with "magic ampersand" in it.
	#

	proc ::tk::mcmaxamp {args} {
	set maxlen 0
	foreach arg $args {
	set length [string length [lindex [::tk::UnderlineAmpersand [mc $arg]] 0]]
	if {$length>$maxlen} {
	set maxlen $length
	}
	}
	return $maxlen
	}
	# For now, turn off the custom mdef proc for the mac:

	if {[string equal [tk windowingsystem] "aqua"]} {
	namespace eval ::tk::mac {
	set useCustomMDEF 0
	}
	}