#
 # 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
 # 256 | Button-1
 # 512 | Button-2

 # Modifications to the the gnocl text.c code
 # If there version of Gnocl used is pre 0.9.92, then 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 },

 # remove comments to execute the demo
 set DEMO 1
 if {$DEMO} { 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 the easiest!
   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
 # concatenate these bindings with others which may have been assigned to events
 #---------------
 proc gnocl::bind {widget event script} {

        # what are the existing bindings?

        # cget not yet implemented
        # puts "keyPress [$widget cget -onKeyPress]"
        # puts "buttonPress [$widget cget -onButtonPress]"

        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 -----
 if {$DEMO} {

 proc bind:demo {} {

   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

   gnocl::bind $txt <Shift-Key-a> {puts "Say 'Shift-a'"}
   gnocl::bind $txt <Alt-Key-A> {puts "Say 'Alt-a'"}
   gnocl::bind $txt <Alt-Key-a> {puts "Say 'Alt-a'"}
   gnocl::bind $txt <Ctrl-Key-a> {puts "Say 'Ctrl-a'"}
   gnocl::bind $txt <Shift-Alt-Key-a> {puts "Say 'Shift-Alt-a'"}
   gnocl::bind $txt <Shift-Ctrl-Key-a> {puts "Say 'Shift-Ctrl-a'"}
   gnocl::bind $txt <Shift-Alt-Ctrl-Key-a> {puts "Say 'Shift-Alt-Ctrl-a'"}

   gnocl::bind $txt <Ctrl-Key-F1> {puts "Ctrl F1"}
   gnocl::bind $txt <Shift-Key-F1> {puts "Shift F1"}
   gnocl::bind $txt <Key-F2> {puts "F2"}

   gnocl::bind $txt <Alt-Button1> {puts "Alt Button1!"}
   gnocl::bind $txt <Ctrl-Button1> {puts "Ctrl Button1!"}
   gnocl::bind $txt <Shift-Button1> {puts "Shift Button1! $::gnocl::x $::gnocl::y"}

   gnocl::bind $txt <Alt-Button2> {puts "Alt Button2!"}
   gnocl::bind $txt <Ctrl-Button2> {puts "Ctrl Button2!"}
   gnocl::bind $txt <Shift-Button2> {puts "Shift Button2!"}

   gnocl::bind $txt <Ctrl-Key-z> {puts "UNDO!"}
   gnocl::bind $txt <Shift-Ctrl-Key-z> {puts "REDO!"}

 }

 # the ubiquitous demo
 bind:demo
 }