# jentrykeys.tcl - support for Entry key bindings
#
######################################################################
# Copyright 1992-1999 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]
  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:repeatable tclcode W - execute tclcode one or more times
######################################################################

proc j:ekb:repeatable { tclcode W args } {
  global j_teb
  
  # set up prefix/repeat information if this widget hasn't been used yet
  if {! [info exists j_teb(prefix,$W)]} {
    set j_teb(prefix,$W) 0
  }
  if {! [info exists j_teb(repeat_count,$W)]} {
    set j_teb(repeat_count,$W) 1
  }

  # special-case prefix == 1 and repeat_count == 0 for Emacs ^U:
  #
  if {$j_teb(prefix,$W) == 1 && $j_teb(repeat_count,$W) == 0} {
    set j_teb(repeat_count,$W) 4
  }
  
  set j_teb(prefix,$W) 0			;# no longer collectig digits
  for {set jri 0} {$jri < $j_teb(repeat_count,$W)} {incr jri} {
    uplevel 1 "eval [list $tclcode]"		;# variables in caller
  }
  set j_teb(repeat_count,$W) 1
}

######################################################################
######################################################################
### DUMMY PROCEDURES:
proc j:ekb:clear_count { W args } {}
proc j:ekb:start_number { W args } {}
proc j:ekb:continue_number { W args } {}
######################################################################

######################################################################
# j:ekb:paste_selection W - insert the X selection in an entry
######################################################################

proc j:ekb:paste_selection { W args } {
  $W insert insert [string trim [::aq::selection_if_any] "\n\r"]
  j:ek:see_insert $W
}

######################################################################
######################################################################
### DUMMY PROCEDURES:
proc j:ekb:scroll_down { W args } {j:eb:beep $W}
proc j:ekb:scroll_up { W args } {j:eb:beep $W}
######################################################################

######################################################################
# j:ekb:insert_newline W K A - insert "\n" into W, [clear arg flag]
######################################################################

proc j:ekb:insert_newline { W K A } {
  global j_teb J_PREFS
  
  if $J_PREFS(typeover) {
    catch {
      $W delete sel.first sel.last
    }
  }
  
  $W insert insert "\n"
  j:ek:see_insert $W
}

######################################################################
# 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:self_insert_digit W K A - insert A into entry widget W
# * handles deletion of selection if needed
######################################################################

proc j:ekb:self_insert_digit { W K A } {
  j:ekb:self_insert $W $K $A
}

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

# 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
}

# dummy procedures:
proc j:ekb:up { W args } {j:eb:beep $W}
proc j:ekb:down { W args } {j:eb:beep $W}

# 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
}

proc j:ekb:bof { W args } {j:ekb:bol $W}
proc j:ekb:eof { W args } {j:ekb:eol $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: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_left_word W - move one word left
# hacked from tk_entryBackword in entry.tcl
proc j:ekb:delete_left_word { W args } {
  set string [$W get]
  set length [string length $string]
  set curs [expr [$W index insert]-1]
  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_right_word W - move one word right
# hacked from tk_entryBackword in entry.tcl
### NOTE: I'm not sure this works right under Tk 3.6
proc j:ekb:delete_right_word { 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]] " \t"] >= 0} {
      break
    }
  }
  $W delete insert $end
  j:ek:see_insert $W
}
