# jtextkeys.tcl - support for Text keyboard 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:tkb:mkmap w map next {{key command ?args?}...} - set up pseudo-binding
#   Note that key includes modifier
######################################################################

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

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

proc j:tkb: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,Text)
  }
  # 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(tkm,$W,$map,$K)] {
    # specific action for this widget
    set command $j_teb(tkm,$W,$map,$K)
    eval $command [list $W $K $A]
  } else {
    if [info exists j_teb(tkm,Text,$map,$K)] {
      # specific binding for all Text widgets
      set command $j_teb(tkm,Text,$map,$K)
      eval $command [list $W $K $A]
    } else {
      if [info exists j_teb(tkm,$W,$map,$default)] {
        # default key action for this widget
        set command $j_teb(tkm,$W,$map,$default)
        eval $command [list $W $K $A]
      } else {
        # default key action for Text widgets
        set command $j_teb(tkm,Text,$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(tkm_next,$W,$map)] {
      set j_teb(next_keymap,$W) $j_teb(tkm_next,$W,$map)
    } else {
      set j_teb(next_keymap,$W) $j_teb(tkm_next,Text,$map)
    }
  }
  set j_teb(keymap,$W) $j_teb(next_keymap,$W)
}

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

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

######################################################################
# j:tkb:repeatable tclcode W - execute tclcode one or more times
######################################################################

proc j:tkb: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
}

######################################################################
# j:tkb:clear_count W - clear argument count
######################################################################

proc j:tkb:clear_count { 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
  }

  set j_teb(repeat_count,$W) 1
  set j_teb(prefix,$W) 0
}

######################################################################
# j:tkb:start_number W K digit - start a numeric argument
#   invalid if not bound to (a sequence ending in) a digit key
######################################################################

proc j:tkb:start_number { W K digit } {
  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(prefix,$W) 1
  }

  set j_teb(prefix,$W) 1			;# collecting # prefix
  set j_teb(repeat_count,$W) [expr "$digit"]
}

######################################################################
# j:tkb:continue_number digit - continue a numeric argument
#   invalid if not bound to a digit key
######################################################################

proc j:tkb:continue_number { W K digit } {
  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(prefix,$W) 1
  }

  if {! $j_teb(prefix,$W)} {		;# (can start as well as continue)
    set j_teb(prefix,$W) 1	
    set j_teb(repeat_count,$W) 0
  }
  set j_teb(repeat_count,$W) [expr {($j_teb(repeat_count,$W)*10)+$digit}]
}

######################################################################
# j:tkb:paste_selection W - insert X selection into W
######################################################################

# j:tkb:paste_selection W - insert selection into W
#  (could also be used as mouse or key binding)
proc j:tkb:paste_selection { W K A } {
  set selection [j:selection_if_any]
  
  if {[string length $selection] != 0} {
    j:text:insert_string $W $selection
  }
}

######################################################################
###  TEXT SCROLLING COMMANDS - fragile - assume widget has a scrollbar
######################################################################
# fragile---assumes first word of yscrollcommand is name of scrollbar!
# should catch case of no yscrollcommand!
# ALSO---should handle arguments (scroll by line rather than windowful)

proc j:tkb:scroll_down { W K A } {
  global j_teb
  j:tkb:clear_count $W
  
  j:tk3 {
    set yscrollcommand [lindex [$W configure -yscrollcommand] 4]
    set scrollbar [lindex $yscrollcommand 0]	;# cross fingers and hope!
    
    j:tb:move $W "[lindex [$scrollbar get] 3].0"
    $W yview insert				;# this is essential!
  }
  j:tk4 {
    $W yview scroll 1 pages
    j:tb:move $W @0,0
  }
}

proc j:tkb:scroll_up { W K A } {
  global j_teb
  j:tkb:clear_count $W
  
  j:tk3 {
    set yscrollcommand [lindex [$W configure -yscrollcommand] 4]
    set scrollbar [lindex $yscrollcommand 0]	;# cross fingers and hope!
    
    set currentstate [$scrollbar get]
    # following is buggy if lines wrap:
    set newlinepos [expr {[lindex $currentstate 2] - [lindex $currentstate 1]}]
    j:tb:move $W "$newlinepos.0-2lines"
    $W yview insert
  }
  j:tk4 {
    $W yview scroll -1 pages
    j:tb:move $W @0,0
  }
}



######################################################################
### INSERTION COMMANDS
######################################################################

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

proc j:tkb:insert_newline { W K A } {
  global j_teb

  j:tkb:repeatable {
    j:text:insert_string $W "\n"
  } $W
}

######################################################################
# j:tkb:self_insert W K A - insert A into text widget W, clear arg flag
### (was j:tb:self_insert_nondigit
######################################################################

proc j:tkb:self_insert { W K A } {
  global j_teb

  if {"x$A" != "x"} {
    j:tkb:repeatable {
      j:text:insert_string $W $A
    } $W
  }
}

######################################################################
# j:tkb:self_insert_digit W K A - insert digit A into W, unless collecting arg
######################################################################

proc j:tkb:self_insert_digit { W K A } {
  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 $j_teb(prefix,$W) {
    j:tkb:continue_number $W $K $A
    return 0
  } else {
    if {"x$A" != "x"} {
      j:tkb:repeatable {
        j:text:insert_string $W $A
      } $W
    }
  }
}

######################################################################
###  TEXT MOVEMENT COMMANDS
######################################################################

# j:tkb:bol W K A - move to start of line (ignores count)
proc j:tkb:bol { W K A } {
  j:tkb:repeatable {j:tb:move $W {insert linestart}} $W
}

# j:tkb:eol W K A - move to end of line (ignores count)
proc j:tkb:eol { W K A } {
  j:tkb:repeatable {j:tb:move $W {insert lineend}} $W
}

# j:tkb:up W K A - move up
proc j:tkb:up { W K A } {
  j:tkb:repeatable {j:tb:move $W {insert - 1 line}} $W
}

# j:tkb:down W K A - move down
proc j:tkb:down { W K A } {
  j:tkb:repeatable {j:tb:move $W {insert + 1 line}} $W
}

# j:tkb:left W K A - move left
proc j:tkb:left { W K A } {
  j:tkb:repeatable {j:tb:move $W {insert - 1 char}} $W
}

# j:tkb:right W K A - move right
proc j:tkb:right { W K A } {
  j:tkb:repeatable {j:tb:move $W {insert + 1 char}} $W
}

# j:tkb:bof W K A - move to beginning of file (widget)
proc j:tkb:bof { W K A } {
  j:tkb:repeatable {
    j:tb:move $W 0.0
  } $W
}

# j:tkb:eof W K A - move to end of file (widget)
proc j:tkb:eof { W K A } {
  j:tkb:repeatable {
    j:tb:move $W end
  } $W
}

# j:tkb:word_left W K A - move back one word
proc j:tkb:word_left { W K A } {
  j:tkb:repeatable {
    while {[$W compare insert != 1.0] &&
           [string match "\[ \t\n\]" [$W get {insert - 1 char}]]} {
      j:tb:move $W {insert - 1 char}
    }
    while {[$W compare insert != 1.0] &&
           ![string match "\[ \t\n\]" [$W get {insert - 1 char}]]} {
      j:tb:move $W {insert - 1 char}
    }
  } $W
}

# j:tkb:word_right W K A - move forward one word
proc j:tkb:word_right { W K A } {
  j:tkb:repeatable {
    while {[$W compare insert != end] &&
           [string match "\[ \t\n\]" [$W get insert]]} {
      j:tb:move $W {insert + 1 char}
    }
    while {[$W compare insert != end] &&
           ![string match "\[ \t\n\]" [$W get insert]]} {
      j:tb:move $W {insert + 1 char}
    }
  } $W
}

######################################################################
###  TEXT DELETION COMMANDS
######################################################################

# j:tkb:delete_right W K A - delete character at insert
proc j:tkb:delete_right { W K A } {
  global J_PREFS
  global j_teb
  
  if {[j:text:insert_touches_selection $W] && $J_PREFS(typeover)} {
    set j_teb(modified,$W) 1
    j:text:delete $W sel.first sel.last
    j:tkb:clear_count $W
    return 0
  }
    
  if [$W compare insert != end] {
    set j_teb(modified,$W) 1
    set delete_from [$W index insert]
    j:tkb:right $W $K $A	;# handles repeat count
    set delete_to [$W index insert]
    j:text:delete $W $delete_from $delete_to
  }
}

# j:tkb:delete_left W K A - delete character before insert
proc j:tkb:delete_left { W K A } {
  global J_PREFS
  global j_teb
  
  if {[j:text:insert_touches_selection $W] && $J_PREFS(typeover)} {
    set j_teb(modified,$W) 1
    j:text:delete $W sel.first sel.last
    j:tkb:clear_count $W
    return 0
  }
  
  if [$W compare insert != 1.0] {
    set j_teb(modified,$W) 1
    
    set delete_to [$W index insert]
    j:tkb:left $W $K $A		;# handles repeat count
    set delete_from [$W index insert]
    j:text:delete $W $delete_from $delete_to
  }
}

#### FOLLOWING TWO NEED TO HANDLE CUTBUFFER!

# j:tkb:delete_left_word W K A - move back one word
proc j:tkb:delete_left_word { W K A } {
  if [$W compare insert != 1.0] {
    global j_teb
    set j_teb(modified,$W) 1
  
    set delete_to [$W index insert]
    j:tkb:word_left $W $K $A	;# handles repeat count
    set delete_from [$W index insert]
    j:text:delete $W $delete_from $delete_to
  }
}

# j:tkb:delete_right_word W K A - move forward one word
proc j:tkb:delete_right_word { W K A } {
  if [$W compare insert != end] {
    global j_teb
    set j_teb(modified,$W) 1
  
    set delete_from [$W index insert]
    j:tkb:word_right $W $K $A	;# handles repeat count
    set delete_to [$W index insert]
    j:text:delete $W $delete_from $delete_to
  }
}



