diff options
Diffstat (limited to 'library/tearoff.tcl')
| -rw-r--r-- | library/tearoff.tcl | 43 |
1 files changed, 32 insertions, 11 deletions
diff --git a/library/tearoff.tcl b/library/tearoff.tcl index c68c32d..7a240c3 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -2,7 +2,7 @@ # # This file contains procedures that implement tear-off menus. # -# RCS: @(#) $Id: tearoff.tcl,v 1.3 1998/09/14 18:23:25 stanton Exp $ +# RCS: @(#) $Id: tearoff.tcl,v 1.4 1999/04/16 01:51:27 stanton Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -40,11 +40,11 @@ proc tkTearOffMenu {w {x 0} {y 0}} { } set parent [winfo parent $w] - while {([winfo toplevel $parent] != $parent) - || ([winfo class $parent] == "Menu")} { + while {[string compare [winfo toplevel $parent] $parent] + || ![string compare [winfo class $parent] "Menu"]} { set parent [winfo parent $parent] } - if {$parent == "."} { + if {![string compare $parent "."]} { set parent "" } for {set i 1} 1 {incr i} { @@ -61,7 +61,7 @@ proc tkTearOffMenu {w {x 0} {y 0}} { # entry. If it's a menubutton then use its text. set parent [winfo parent $w] - if {[$menu cget -title] != ""} { + if {[string compare [$menu cget -title] ""]} { wm title $menu [$menu cget -title] } else { switch [winfo class $parent] { @@ -92,7 +92,7 @@ proc tkTearOffMenu {w {x 0} {y 0}} { # now. set cmd [$w cget -tearoffcommand] - if {$cmd != ""} { + if {[string compare $cmd ""]} { uplevel #0 $cmd $w $menu } return $menu @@ -121,7 +121,7 @@ proc tkMenuDup {src dst type} { } eval $cmd set last [$src index last] - if {$last == "none"} { + if {![string compare $last "none"]} { return } for {set i [$src cget -tearoff]} {$i <= $last} {incr i} { @@ -134,12 +134,33 @@ proc tkMenuDup {src dst type} { # Duplicate the binding tags and bindings from the source menu. - regsub -all . $src {\\&} quotedSrc - regsub -all . $dst {\\&} quotedDst - regsub -all $quotedSrc [bindtags $src] $dst x + set tags [bindtags $src] + set srcLen [string length $src] + + # Copy tags to x, replacing each substring of src with dst. + + while {[set index [string first $src $tags]] != -1} { + append x [string range $tags 0 [expr {$index - 1}]]$dst + set tags [string range $tags [expr {$index + $srcLen}] end] + } + append x $tags + bindtags $dst $x + foreach event [bind $src] { - regsub -all $quotedSrc [bind $src $event] $dst x + unset x + set script [bind $src $event] + set eventLen [string length $event] + + # Copy script to x, replacing each substring of event with dst. + + while {[set index [string first $event $script]] != -1} { + append x [string range $script 0 [expr {$index - 1}]] + append x $dst + set script [string range $script [expr {$index + $eventLen}] end] + } + append x $script + bind $dst $event $x } } |