# jentrykeys.tcl - support for Entry key bindings
#
######################################################################
# Copyright 1992-1995 by Jay Sekora.  This file may be freely        #
# distributed, modified or unmodified, for any purpose, provided     #
# that this copyright notice is retained verbatim in all copies and  #
# no attempt is made to obscure the authorship of this file.  If you #
# distribute any modified versions, I ask, but do not require, that  #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources.     #
######################################################################

######################################################################
# j:ekb:mkmap w map next {{key command ?args?}...} - set up pseudo-binding
#   Note that key includes modifier; w can be particular widget or class
######################################################################

proc j:ekb:mkmap { w map next bindings } {
  global j_teb
  
  foreach list $bindings {
    set key [lindex $list 0]
    set command [lreplace $list 0 0]
    
    set j_teb(ekm,$w,$map,$key) $command
    set j_teb(ekm_next,$w,$map) $next
  }
}

######################################################################
# j:ekb:process_key W mod K A - process keystrokes
######################################################################

proc j:ekb:process_key {W mod K A} {
  global j_teb
  
  set j_teb(next_keymap,$W) ""		;# some bindings change this
  
  if {"x$mod" != "x"} {
    set K "$mod-$K"
    set default "$mod-DEFAULT"
  } else {
    set default "DEFAULT"
  }
  
  # if this widget hasn't been used before, set its keymap from default
  if {! [info exists j_teb(keymap,$W)]} {
    set j_teb(keymap,$W) $j_teb(keymap,Entry)
  }
  # if no last command, set it to {}
  if {! [info exists j_teb(last_command,$W)]} {
    set j_teb(last_command,$W) {}
  }
  set map $j_teb(keymap,$W)

  if [info exists j_teb(ekm,$W,$map,$K)] {
    # specific action for this widget
    set command $j_teb(ekm,$W,$map,$K)
    eval $command [list $W $K $A]
  } else {
    if [info exists j_teb(ekm,Entry,$map,$K)] {
      # specific binding for all Entry widgets
      set command $j_teb(ekm,Entry,$map,$K)
      eval $command [list $W $K $A]
    } else {
      if [info exists j_teb(ekm,$W,$map,$default)] {
        # default key action for this widget
        set command $j_teb(ekm,$W,$map,$default)
        eval $command [list $W $K $A]
      } else {
        # default key action for Entry widgets
        set command $j_teb(ekm,Entry,$map,$default)
        eval $command [list $W $K $A]
      }
    }
  }
  set j_teb(last_command,$W) $command
  
  # if a binding hasn't explicitly chosen a different keymap for the next
  #   key, switch to the default next keymap for this keymap:
  if {"x$j_teb(next_keymap,$W)" == "x"} {
    if [info exists j_teb(ekm_next,$W,$map)] {
      set j_teb(next_keymap,$W) $j_teb(ekm_next,$W,$map)
    } else {
      set j_teb(next_keymap,$W) $j_teb(ekm_next,Entry,$map)
    }
  }
  set j_teb(keymap,$W) $j_teb(next_keymap,$W)
}

######################################################################
# j:ek:see_insert W - make sure insert point is visible
#   copied from tkEntrySeeInsert/tk_entrySeeCaret in the Tk library
######################################################################

proc j:ek:see_insert { W } {
  set c [$W index insert]
  set left [$W index @0]
  j:tk3 {
    if {$left >= $c} {
      if {$c > 0} {
          $W view [expr $c-1]
      } else {
          $W view $c
      }
      return
    }
    set x [expr [winfo width $W] - [lindex [$W config -bd] 4] - 1]
    while {([$W index @$x] < $c) && ($left < $c)} {
      set left [expr $left+1]
      $W view $left
    }
  }
  j:tk4 {
    if {$left > $c} {
      $W xview $c
      return
    }
    set x [winfo width $W]
    while {([$W index @$x] <= $c) && ($left < $c)} {
      incr left
      $W xview $left
    }
  }
}

######################################################################
# j:ekb:new_mode mode W K A - change modes
######################################################################

proc j:ekb:new_mode { mode W K A } {
  global j_teb
  set j_teb(next_keymap,$W) $mode
}

######################################################################
# j:ekb:self_insert W K A - insert A into entry widget W
# * handles deletion of selection if needed
######################################################################

proc j:ekb:self_insert { W K A } {
  global j_teb J_PREFS
  
  if $J_PREFS(typeover) {
    catch {
      $W delete sel.first sel.last
    }
  }

  if {"$A" != ""} {
    $W insert insert $A
    j:ek:see_insert $W
  }
}

######################################################################
# j:ekb:clear_and_insert W K A - clear entry widget W and insert A
######################################################################

proc j:ekb:clear_and_insert { W K A } {
  global j_teb
  puts stdout foo
  
  $W delete 0 end
  
  if {"$A" != ""} {
    $W insert insert $A
    j:ek:see_insert $W
  }
}

######################################################################
### ENTRY MOVEMENT ROUTINES
######################################################################

# j:ekb:left W - move one character left
proc j:ekb:left { W args } {
  $W icursor [expr {[$W index insert] - 1}]
  j:ek:see_insert $W
}

# j:ekb:right W - move one character right
proc j:ekb:right { W args } {
  $W icursor [expr {[$W index insert] + 1}]
  j:ek:see_insert $W
}

# j:ekb:bol W - move to beginning of entry
proc j:ekb:bol { W args } {
  $W icursor 0
  j:ek:see_insert $W
}

# j:ekb:eol W - move to end of entry
proc j:ekb:eol { W args } {
  $W icursor end
  j:ek:see_insert $W
}

# j:ekb:word_left W - move one word left
# hacked from tk_entryBackword in entry.tcl
proc j:ekb:word_left { W args } {
  set string [$W get]
  set length [string length $string]
  set curs [expr [$W index insert]-2]
  if {$curs < 0} return
  for {set start $curs} {$start > 0} {incr start -1} {
    if {[string first [string index $string $start] " \t"] >= 0} {
      incr start
      break
    }
    if {([string first [string index $string $start] " \t"] < 0)
       && ([string first [string index $string [expr $start-1]] " \t"]
    	>= 0)} {
      break
    }
  }
  $W icursor $start
  j:ek:see_insert $W
}

# j:ekb:word_right W - move one word right
# hacked from tk_entryBackword in entry.tcl
proc j:ekb:word_right { W args } {
  set string [$W get]
  set length [string length $string]
  set curs [expr [$W index insert]+1]

  for {set end $curs} {$end < $length} {incr end 1} {
    if {[string first [string index $string $end] " \t"] >= 0} {
      break
    }
  }
  $W icursor $end
  j:ek:see_insert $W
}

######################################################################
###  ENTRY DELETION ROUTINES
######################################################################

# j:ekb:clear W - clear entire widget
proc j:ekb:clear { W args } {
  $W delete 0 end
}

# j:ekb:delete_left W - delete character before insert
proc j:ekb:delete_left { W args } {
  global J_PREFS
  
  if {$J_PREFS(typeover) && ![catch {selection get} s]} {
    if {"x[selection own]" == "x$W"} {
      $W delete sel.first sel.last
      return 0
    }
  }
  set x [expr {[$W index insert] - 1}]
  if {$x >= 0} {$W delete $x}
  j:ek:see_insert $W
}

# j:ekb:delete_right W - delete character after insert
proc j:ekb:delete_right { W args } {
  global J_PREFS
  
  if {$J_PREFS(typeover) && ![catch {selection get} s]} {
    if {"x[selection own]" == "x$W"} {
      $W delete sel.first sel.last
      return 0
    }
  }
  $W delete insert
  j:ek:see_insert $W
}

# j:ekb:kill_eol W - delete to eol
proc j:ekb:kill_eol { W args } {
  $W delete insert end
}

# j:ekb:kill_selection W - delete selection
proc j:ekb:kill_selection { W args } {
  catch {
    $W delete sel.first sel.last
  }
}

# j:ekb:delete_word_left W - move one word left
# hacked from tk_entryBackword in entry.tcl
proc j:ekb:delete_word_left { W args } {
  set string [$W get]
  set length [string length $string]
  set curs [expr [$W index insert]-2]
  if {$curs < 0} return
  for {set start $curs} {$start > 0} {incr start -1} {
    if {[string first [string index $string [expr $start-1]] " \t"] >= 0} {
      break
    }
  }
  $W delete $start [expr {$curs+1}]
  j:ek:see_insert $W
}

# j:ekb:delete_word_right W - move one word right
# hacked from tk_entryBackword in entry.tcl
proc j:ekb:delete_word_right { W args } {
  set string [$W get]
  set length [string length $string]
  set curs [expr [$W index insert]+1]

  for {set end $curs} {$end < $length} {incr end 1} {
    if {[string first [string index $string [expr $end+1]] " \t"] >= 0} {
      break
    }
  }
  $W delete insert $end
  j:ek:see_insert $W
}
