# copyright (C) 1997-98 Jean-Luc Fontaine (mailto:jfontain@mygale.org)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

set rcsId {$Id: keyslink.tcl,v 1.5 1998/05/24 19:24:43 jfontain Exp $}

# simple class to safely add key bindings to a button so that if follows the keys move:
# sinks when keys is pressed, raises when key is released
# object safely self destructs when button is destroyed, so there is usually no need to store the object identifier

class buttonKeysLink {
    # optional parameter is the bindings path, which may differ from the button path when for example, pressing the return key
    # in a dialog box is equivalent to pressing the OK button. In this case, one must use the dialog box path for bindings
    proc buttonKeysLink {this buttonPath keySymbols {bindPath {}}} {       ;# list of key symbols as defined in the bind manual page
        if {[string length $bindPath]==0} {
            set bindings [new bindings $buttonPath 0]
        } else {
            set bindings [new bindings $bindPath 0]
        }
        foreach key $keySymbols {                                                                        ;# match moves for each key
            bindings::set $bindings <KeyPress-$key> "$buttonPath configure -relief sunken"
            bindings::set $bindings <KeyRelease-$key> "$buttonPath configure -relief raised"
        }
        bindings::set $bindings <Destroy> "delete $this"                                              ;# self destruct before target
        set buttonKeysLink::($this,bindings) $bindings
    }
    proc ~buttonKeysLink {this} {
        delete $buttonKeysLink::($this,bindings)
    }
}