bind.tcl

WJG (20/07/08) gnocl handles event bindings in a slightly different way to Tk. Indeed, whilst I haven't compared them exactly, I expect that there might not be an exact mapping between Tk and Gtk+ bindings. In some ways, the Gnocl way of doing things may be a little simpler. Rather than having a separate command, ie. bind... , Gnocl uses event switches, more like the -command option found with Tk buttons. However, if we do want to implement some extra bindings here's a useful script. The example below relates to the gnocl::text widget. At the time of writing this page, the current version of the gnocl text widget (0.9.91) does not support events. This, however, is easily rectified. You will need to add a few lines, re-compile and install the code. All that is required is a few simple additions to the widget options union in the source as noted in the comments in the script. That is:

 # Modifications to the the gnocl text.c code
 #
 # Insert the following 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 },

So, have a go and and play. Happy Gnocl-ing....

 #
 # 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" "[email protected]"

 # 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 following 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!"}