# jtextemacs.tcl - additional procedures for Emacs-like Text bindings
#
######################################################################
# Copyright 1992-1998 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.     #
######################################################################

catch {
  package require jldb
}

# TO DO:
# ^L
# sentence-manipulation stuff
# case change commands, transposition commands
# commands to do with mark?
# word deletion - fix to use buffer
# generalise movement to copying-to-cutbuffer and deletion
# IMPROVE ENTRY BINDINGS
# literal-insert for entry

######################################################################
# j:tb:emacs_init t - set emacs bindings up for widget $t (possibly "Text")
######################################################################

proc j:tb:emacs_init { {t Text} } {
  global j_teb
  set j_teb(cutbuffer) {}
  set j_teb(dragscroll,txnd) 0
  set j_teb(dragscroll,delay) 50
  set j_teb(scanpaste_time) 0
  set j_teb(scanpaste_paste) 1
  
  set j_teb(keymap,$t) emacs-normal
  
  j:tb:key_bind $t
  j:tb:mouse_bind $t
  
  j:tkb:mkmap Text emacs-normal emacs-normal {
    {Control-slash		j:tb:select_all}
    {Control-backslash		j:tb:clear_selection}
    
    {Delete			j:tkb:delete_left}
    {BackSpace			j:tkb:delete_left}
    {Return			j:tkb:insert_newline}
    
    {Control-d			j:tkb:delete_right}
    
    {Up				j:tkb:up}
    {Down			j:tkb:down}
    {Left			j:tkb:left}
    {Right			j:tkb:right}
    
    {Control-p			j:tkb:up}
    {Control-n			j:tkb:down}
    {Control-b			j:tkb:left}
    {Control-f			j:tkb:right}
    
    {Home			j:tkb:bol}
    {End			j:tkb:eol}
    
    {Control-a			j:tkb:bol}
    {Control-e			j:tkb:eol}
    
    {Next			j:tkb:scroll_down}
    {Prior			j:tkb:scroll_up}
    
    {Control-v			j:tkb:scroll_down}
    
    {Control-k			j:tkb:e:kill_line}
    {Control-w			j:tkb:e:kill_region}
    {Control-y			j:tkb:e:yank}

    {Control-i			j:tkb:self_insert}
    {Control-j			j:tkb:self_insert}
    {Control-h			j:tkb:delete_left}
    
    {Control-space		j:tkb:e:set_mark_command}
    {Control-at			j:tkb:e:set_mark_command}
    
    {Control-g			j:tkb:clear_count}
    
    {1				j:tkb:self_insert_digit}
    {2				j:tkb:self_insert_digit}
    {3				j:tkb:self_insert_digit}
    {4				j:tkb:self_insert_digit}
    {5				j:tkb:self_insert_digit}
    {6				j:tkb:self_insert_digit}
    {7				j:tkb:self_insert_digit}
    {8				j:tkb:self_insert_digit}
    {9				j:tkb:self_insert_digit}
    {0				j:tkb:self_insert_digit}
    
    {Control-u			j:tkb:e:generic_arg}
    
    {Control-q			j:tkb:new_mode emacs-literal}
    {Control-x			j:tkb:new_mode emacs-control-x}
    {Escape			j:tkb:new_mode emacs-escape}
    
    {Control-DEFAULT		j:tb:no_op}
    {DEFAULT			j:tkb:self_insert}
    {Shift-DEFAULT		j:tkb:self_insert}
  }
  
  j:tkb:mkmap Text emacs-literal emacs-normal {
    {DEFAULT			j:tkb:self_insert}
    {Shift-DEFAULT		j:tkb:self_insert}
    {Control-DEFAULT		j:tkb:self_insert}
    {Meta-DEFAULT		j:tkb:self_insert}
  }
  
  j:tkb:mkmap Text emacs-control-x emacs-normal {
    {Control-g			j:tkb:clear_count}
    {Control-x			j:tkb:e:exchange_point_and_mark}
    
    {h				j:tb:select_all}
    
    {DEFAULT			j:tkb:clear_count}
    {Shift-DEFAULT		j:tkb:clear_count}
    {Control-DEFAULT		j:tkb:clear_count}
    {Meta-DEFAULT		j:tkb:clear_count}
  }
  
  j:tkb:mkmap Text emacs-escape emacs-normal {
    {space			j:tkb:e:just_one_space}
    {less			j:tkb:bof}
    {greater			j:tkb:eof}
    {b				j:tkb:word_left}
    {f				j:tkb:word_right}
    {v				j:tkb:scroll_up}
    {braceleft			j:tkb:e:backward-paragraph}
    {braceright			j:tkb:e:forward-paragraph}
    
    {Delete			j:tkb:delete_left_word}
    {BackSpace			j:tkb:delete_left_word}
    {d				j:tkb:delete_right_word}
    
    {1				j:tkb:start_number}
    {2    			j:tkb:start_number}
    {3    			j:tkb:start_number}
    {4    			j:tkb:start_number}
    {5    			j:tkb:start_number}
    {6    			j:tkb:start_number}
    {7    			j:tkb:start_number}
    {8    			j:tkb:start_number}
    {9    			j:tkb:start_number}
    {0    			j:tkb:start_number}
    
    {Control-g			j:tkb:clear_count}
    
    {DEFAULT			j:tb:no_op}
    {Shift-DEFAULT		j:tb:no_op}
    {Control-DEFAULT		j:tb:no_op}
    {Meta-DEFAULT		j:tb:no_op}
  }
}

######################################################################
# j:tkb:e:generic_arg - start generic argument
#   kind of clumsy: set repeat count to four, or multiply by four
######################################################################

proc j:tkb:e:generic_arg { W args } {
  global j_teb
  
  # set up prefix and 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
  }

  if {$j_teb(prefix,$W) == 1 && $j_teb(repeat_count,$W) == 0} {
    set j_teb(repeat_count,$W) 16		;# ^U^U -> 4*4
    return
  }
  if {$j_teb(prefix,$W) == 0} {
    set j_teb(prefix,$W) 1
    set j_teb(repeat_count,$W) 0		;# special; -> 4 in repeatable
    return
  }
  set j_teb(repeat_count,$W) [expr {$j_teb(repeat_count,$W)*4}]
}

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

# j:tkb:e:backward-paragraph W K A - move backward to start of paragraph
# incompatible: doesn't honour negative argument
proc j:tkb:e:backward-paragraph { W K A } {
  j:tkb:repeatable {
    # back one line:
    j:text:move $W {insert -1line linestart}
    # backwards over whitespace:
    while {[$W compare {insert linestart} > 1.0] &&
           [regexp -- "^\[ \t\f\]*\$" [$W get insert {insert lineend}]]} {
      j:text:move $W {insert -1line linestart}
    }
    # backwards over paragraph body:
    while {[$W compare {insert linestart} > 1.0] &&
           ! [regexp -- "^\[ \t\f\]*\$" [$W get insert {insert lineend}]]} {
      j:text:move $W {insert -1line linestart}
    }
  } $W
}

# j:tkb:e:forward-paragraph W K A - move forward to end of paragraph
# incompatible: doesn't honour negative argument
proc j:tkb:e:forward-paragraph { W K A } {
  j:tkb:repeatable {
    # forward one line:
    j:text:move $W {insert +1line linestart}
    # forwards over whitespace:
    while {[$W compare {insert lineend} < end] &&
           [regexp -- "^\[ \t\f\]*\$" [$W get insert {insert lineend}]]} {
      j:text:move $W {insert +1line linestart}
    }
    # forwards over paragraph body:
    while {[$W compare {insert lineend} < end] &&
           ! [regexp -- "^\[ \t\f\]*\$" [$W get insert {insert lineend}]]} {
      j:text:move $W {insert +1line linestart}
    }
  } $W
}

######################################################################
###  TEXT EMACS EDITING COMMANDS
######################################################################

# j:tkb:e:just_one_space W K A - delete tabs and spaces around insert,
#   replacing with a single space
proc j:tkb:e:just_one_space { W K A } {
  # delete tabs and spaces _after_ insert:
  while {[regexp -- "\[ \t\]" [$W get insert]]} {
    j:text:delete $W [$W index insert] [$W index insert]+1char
  }
  # delete tabs and spaces _before_ insert:
  while {[$W index insert] != 1.0 &&
      [regexp -- "\[ \t\]" [$W get insert-1char]]} {
    j:text:delete $W [$W index insert-1char] [$W index insert]
  }
  # insert a single space:
  j:text:insert $W " "
}

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

# j:tkb:e:kill_line W K A - delete insert to end-of-line, setting cutbuffer
#   (arg handled by called procedure)
proc j:tkb:e:kill_line { W K A } {
  global j_teb
  set j_teb(modified,$W) 1
  
  # set up prefix and 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
  }

  # Append to cutbuffer if previous command was line-kill; otherwise
  #   start with new cutbuffer:
  set my_name [lindex [info level 0] 0]
  if {! [string match $my_name $j_teb(last_command,$W)]} {
    set j_teb(cutbuffer) {}
  }
  
  # special-case prefix == 1 and repeat_count == 0 for Emacs ^U^U:
  #
  if {$j_teb(prefix,$W) == 1 && $j_teb(repeat_count,$W) == 0} {
    set j_teb(repeat_count,$W) 4
  }
  
  # if no argument, DON'T kill "\n" unless it's only thing at insert
  #
  if {$j_teb(repeat_count,$W) < 2} {
    j:tkb:clear_count $W			;# in case it's eg -1
    if {[$W index insert] == [$W index {insert lineend}]} then {
      append j_teb(cutbuffer) [$W get insert]
      j:text:delete $W insert {insert + 1 char}
    } else {
      append j_teb(cutbuffer) [$W get insert {insert lineend}]
      j:text:delete $W insert {insert lineend}
    }
  } else {
    # with argument, kill that many lines (including "\n")
    j:tkb:repeatable {
      append j_teb(cutbuffer) [$W get insert {insert lineend + 1 char}]
      j:text:delete $W insert {insert lineend + 1 char}
    } $W
  }
  
  set j_teb(repeat_count,$W) 1
}

# j:tkb:e:kill_region W K A - delete selected region, setting cutbuffer
###   emacs region shouldn't be conflated with Text selection!
proc j:tkb:e:kill_region { W K A } {
  global j_teb
  set j_teb(modified,$W) 1

  j:tkb:clear_count $W

  set j_teb(cutbuffer) {}
  catch {
    set j_teb(cutbuffer) [$W get sel.first sel.last]
    j:text:delete $W sel.first sel.last
  }
}

# j:tkb:e:yank W K A - insert contents of cutbuffer
###   handling of argument needs changed---not count, but not ignored
proc j:tkb:e:yank { W K A } {
  global j_teb

  j:tkb:clear_count $W
  
  j:text:insert $W $j_teb(cutbuffer)
}

######################################################################
###  TEXT EMACS MARK COMMANDS
######################################################################

# j:tkb:e:set_mark_command W K A - set emacs mark at current insert point
proc j:tkb:e:set_mark_command { W K A } {
  $W mark set emacs_mark insert
}

# j:tkb:e:exchange_point_and_mark W K A - swap insert point and emacs mark
proc j:tkb:e:exchange_point_and_mark { W K A } {
  if {[lsearch [$W mark names] emacs_mark] != -1} {
    set mark [$W index emacs_mark]
    $W mark set emacs_mark insert
    j:tb:move $W $mark
  } else {
    error [subst [::jldb::long_text textemacs:nomarkset \
      {The mark is not set in text widget $W.}]]
  }
}

# deprecated alias for backwards-compatibility:

proc j:tb:emacs_bind { W } {
  j:tb:emacs_init $W
}
