#
# gnocl::bind.tcl
#
# This file adds keysequence bindings to a gnocl widget
#
# Author: William J Giddings, 13-Sept-2007
# basic Tcl/Gnocl Script
#!/bin/sh/
#\
exec tclsh "$0" "$@"
# Modifier Bitmask Values
#
# 0 | no modifiers
# 1 | Shift
# 2 | Caps_Lock on
# 4 | Control_L/R
# 8 | Alt_L/R
# 16 | Num_Lock (on)
# 32 | ?
# 64 | Super_L/R
# 128 | alt-gr
# I've seen these values appear, but..
# 256 | Button-1
# 512 | Button-2
# Modifications to the the gnocl text.c code
#
# Insert the folling options into the static GnoclOption textOptions[] array, recompile and re-install.
#
# { "-onKeyPress", GNOCL_OBJ, "P", gnoclOptOnKeyPress },
# { "-onKeyRelease", GNOCL_OBJ, "R", gnoclOptOnKeyRelease },
# { "-onButtonPress", GNOCL_OBJ, "P", gnoclOptOnButton },
# { "-onButtonRelease", GNOCL_OBJ, "R", gnoclOptOnButton },
package require Gnocl
#---------------
# As I like real-words rather than deniary
#---------------
proc kb_modifiers {v} {
set state 0
set flags {
Shift 1
Caps_Lock 2
Ctrl 4
Alt 8
Num_Lock 16
Super 64
Alt-Gr 128
Button_1 256
Button_2 512
}
foreach {a b} $flags {
if {$v & $b } {lappend state $a}
}
return $state
}
#---------------
# create binding handler
#---------------
proc gnocl::keyBindingHandler {w s K} {
# remove Num_Lock On event bitmask
set event [lindex $s 0]
if {16 & $event} { set event [expr 16 ^ $event ] }
set s [lreplace $s 0 0 $event]
# check for Shift, if a single letter, restore to lowercase
if {1 & $event && [string length $K] == "1"} { set K [string tolower $K] }
set events [array names ::keyBindings]
# sorry, not the best practice to error trap with catch, but.... its easy!
catch { eval $::keyBindings($s,$K) }
}
#---------------
# create binding handler
#---------------
proc gnocl::buttonBindingHandler { w s b x y} {
# remove Num_Lock On event bitmask
set event [lindex $s 0]
if {16 & $event} { set event [expr 16 ^ $event ] }
set s [lreplace $s 0 0 $event]
# execute binding
catch {
# save current pointer coordinate of last click
set ::gnocl::x $x
set ::gnocl::y $y
eval [ set ${w}buttonBindings($s,Button$b) ]
}
}
#---------------
# assign bindings to (text) widget
#---------------
proc bind {widget event script} {
set event [string trimleft $event "<"]
set event [string trimright $event ">" ]
set tmp "-"
regsub -all -- - $event " " event
# parse event and create BITMASK
set bitMask 0
foreach {eventType bitVal} {
Shift 1
Ctrl 4
Alt 8
} {
if { [string first $eventType $event] != -1 } {
set bitMask [expr $bitMask + $bitVal]
}
}
if {[string first Key $event]!=-1} {
# add to the list of Key events
set ::keyBindings($bitMask,[lindex $event end]) $script
} elseif {[string first Button $event]!=-1 } {
# add to the list of Button Events
set ${widget}buttonBindings($bitMask,[lindex $event end]) $script
}
# attach bindings
$widget configure -onKeyPress { gnocl::keyBindingHandler %w %s %K }
$widget configure -onButtonPress { gnocl::buttonBindingHandler %w %s %b %x %y }
}
#----- DEMO CODE -----
set txt [gnocl::text]
gnocl::window \
-child $txt \
-title "GNOCL Text Bindings" \
-visible 1 \
-width 250 \
-height 120 \
-onDestroy {exit}
$txt insert end TEST
# Add some bindings, some of these will conflict with GTK defaults
# These bindings do not replace the defaults as in TK
bind $txt <Shift-Key-a> {puts "Say 'Shift-a'"}
bind $txt <Alt-Key-A> {puts "Say 'Alt-a'"}
bind $txt <Alt-Key-a> {puts "Say 'Alt-a'"}
bind $txt <Ctrl-Key-a> {puts "Say 'Ctrl-a'"}
bind $txt <Shift-Alt-Key-a> {puts "Say 'Shift-Alt-a'"}
bind $txt <Shift-Ctrl-Key-a> {puts "Say 'Shift-Ctrl-a'"}
bind $txt <Shift-Alt-Ctrl-Key-a> {puts "Say 'Shift-Alt-Ctrl-a'"}
bind $txt <Ctrl-Key-F1> {puts "Ctrl F1"}
bind $txt <Shift-Key-F1> {puts "Shift F1"}
bind $txt <Key-F2> {puts "F2"}
bind $txt <Alt-Button1> {puts "Alt Button1!"}
bind $txt <Ctrl-Button1> {puts "Ctrl Button1!"}
bind $txt <Shift-Button1> {puts "Shift Button1! $::gnocl::x $::gnocl::y"}
bind $txt <Alt-Button2> {puts "Alt Button2!"}
bind $txt <Ctrl-Button2> {puts "Ctrl Button2!"}
bind $txt <Shift-Button2> {puts "Shift Button2!"}