Tk Source Code

2011-03-28  Donal K. Fellows  <[email protected]>

	* library/tk.tcl (::tk::FindAltKeyTarget): Make this handle the
	traversal of the logical window manager hierarchy correctly. Based on
	comments by Emiliano Gavilan.

2011-03-28  Jan Nijtmans  <[email protected]>

	* generic/tkTextBTree.c: [Bug 3129527]: Fix buffer overflow w/ GCC 4.5
	and -D_FORTIFY_SOURCE=2. One more place where this problem could
	appear.

2011-03-24  Jan Nijtmans  <[email protected]>

	* win/tkWinMenu.c: [Bug #3239768]: tk8.4.19 (and later) WIN32
	menu font support.

2011-03-16  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:    Make SHLIB_LD_LIBS='${LIBS}' the default and
	* unix/configure: set to "" on per-platform necessary basis.
	Backported from TEA, but kept all original platform code which was

	event generate $focus <<TraverseOut>>
    }
    focus $w
    event generate $w <<TraverseIn>>
}

# ::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 s [string map {&& & & \ufeff} $text]
    set idx [string first \ufeff $s]
    return [list [string map {\ufeff {}} $s] $idx]
}

# ::tk::SetAmpText -- 
#	Given widget path and text with "magic ampersands", sets -text and
#	-underline options for the widget
#
proc ::tk::SetAmpText {widget text} {
    lassign [UnderlineAmpersand $text] newtext under
    $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 options {}
    foreach {opt val} $args {
	if {$opt eq "-text"} {
	    lassign [UnderlineAmpersand $val] newtext under
	    lappend options -text $newtext -underline $under
	} else {
	    lappend options $opt $val
	}
    }
    set result [$class $path {*}$options]
    if {[string match "*button" $class]} {
	bind $path <<AltUnderlined>> [list $path invoke]
    }
    return $result
}

# ::tk::AmpMenuArgs --
#	Processes arguments for a menu entry, turning -label option into
#	-label and -underline options, returned by ::tk::UnderlineAmpersand.
#
proc ::tk::AmpMenuArgs {widget add type args} {
    set options {}
    foreach {opt val} $args {
	if {$opt eq "-label"} {
	    lassign [UnderlineAmpersand $val] newlabel under
	    lappend options -label $newlabel -underline $under
	} else {
	    lappend options $opt $val
	}
    }
    $widget add $type {*}$options
}

# ::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} {
    set class [winfo class $path]
    if {$class in {
	Button Checkbutton Label Radiobutton
	TButton TCheckbutton TLabel TRadiobutton
    } && [string equal -nocase $char \
	    [string index [$path cget -text] [$path cget -underline]]]} {
	return $path
    }
    set subwins [concat [grid slaves $path] [pack slaves $path] \
	    [place slaves $path]]
    if {$class eq "Canvas"} {
	foreach item [$path find all] {
	    if {[$path type $item] eq "window"} {
		set w [$path itemcget $item -window]
		if {$w ne ""} {lappend subwins $w}
	    }
	}
    } elseif {$class eq "Text"} {
	lappend subwins {*}[$path window names]
    }
    foreach child $subwins {

	set target [FindAltKeyTarget $child $char]
	if {$target ne ""} {
	    return $target
	}
    }
}




# ::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 [FindAltKeyTarget $path $key]
    if {$target ne ""} {
	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 {
	# Should we run [mc] in caller's namespace?
	lassign [UnderlineAmpersand [mc $arg]] msg