neingeist
/
arduinisten
Archived
1
0
Fork 0
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

89 lines
2.5 KiB
Tcl

# bindings.tcl - Procs to handle bindings.
# Copyright (C) 1997 Cygnus Solutions.
# Written by Tom Tromey <tromey@cygnus.com>.
# Reorder the bindtags so that the tag appears before the widget.
# Tries to preserve other relative orderings as much as possible. In
# particular, nothing changes if the widget is already after the tag.
proc bind_widget_after_tag {w tag} {
set seen_tag 0
set seen_widget 0
set new_list {}
foreach tag [bindtags $w] {
if {$tag == $tag} then {
lappend new_list $tag
if {$seen_widget} then {
lappend new_list $w
}
set seen_tag 1
} elseif {$tag == $w} then {
if {$seen_tag} then {
lappend new_list $tag
}
set seen_widget 1
} else {
lappend new_list $tag
}
}
if {! $seen_widget} then {
lappend new_list $w
}
bindtags $w $new_list
}
# Reorder the bindtags so that the class appears before the widget.
# Tries to preserve other relative orderings as much as possible. In
# particular, nothing changes if the widget is already after the
# class.
proc bind_widget_after_class {w} {
bind_widget_after_tag $w [winfo class $w]
}
# Make the specified binding for KEY and empty bindings for common
# modifiers for KEY. This can be used to ensure that a binding won't
# also be triggered by (eg) Alt-KEY. This proc also makes the binding
# case-insensitive. KEY is either the name of a key, or a key with a
# single modifier.
proc bind_plain_key {w key binding} {
set l [split $key -]
if {[llength $l] == 1} then {
set mod {}
set part $key
} else {
set mod "[lindex $l 0]-"
set part [lindex $l 1]
}
set modifiers {Meta- Alt- Control-}
set part_list [list $part]
# If we just have a single letter, then we can't look for
# Shift-PART; we must use the uppercase equivalent.
if {[string length $part] == 1} then {
# This is nasty: if we bind Control-L, we won't see the events we
# want. Instead we have to bind Shift-Control-L. Actually, we
# must also bind Control-L so that we'll see the event if the Caps
# Lock key is down.
if {$mod != ""} then {
lappend part_list "Shift-[string toupper $part]"
}
lappend part_list [string toupper $part]
} else {
lappend modifiers Shift-
}
foreach part $part_list {
# Bind the key itself (with modifier if required).
bind $w <${mod}${part}> $binding
# Ignore any modifiers other than the one we like.
foreach onemod $modifiers {
if {$onemod != $mod} then {
bind $w <${onemod}${part}> {;}
}
}
}
}