# $Header: /u/ra/raines/src/tk/tkmail2/bindings.tk,v 1.2 1995/05/26 22:15:25 raines Exp $
# Gives more motif-like ands emacs-like bindings to Text and Entry Widgets
global bind_xnd btp

# USER SETTINGS

# maximum number of kills to save in ring
set btp(maxkill) 10
# maximum number of marks to save in ring
set btp(maxmark) 10
# syntax for letter not part of a "word"
set btp(not-word) {[^a-zA-Z_0-9]}
# procedure to use for errors
set btp(error) btp:default-error
# procedure to use for beeping
set btp(beep) ""
# whether to bind Escape prefix commands also to the Meta modifier
set btp(use-meta) 1
# whether to bind Escape prefix commands to Escape
set btp(use-esc-prefix) 1
# column at which to line wrap
set btp(fillcol) 0
# prefix for line wrapping (NOT REALLY WORKING YET)
set btp(fillprefix) ""
# whether to highlight movement after a set-mark
set btp(transient-mark) 1
# number of undo levels to save
set btp(undo-level) 10
# sensitivity to mouse motion
set btp(mouse-motion) 5
# time in milliseconds after which a mouse 2 press is a scan instead of paste
set btp(time-to-scan) 600
# name of tags for which information should stored in cut buffer
set btp(copy-tags) {underline bold italic}

# PRIVATE SETTINGS

set btp(lastkill) 0.0
set btp(killring) ""
set btp(killptr) 0
set btp(killlen) 0
set btp(arg) def
set btp(prevcmd) self-insert
set btp(mark-active) 0

proc btp:default-error { str master } {
    error $str
}

proc tk_entryForwspace w {
     set x [expr [$w index insert] - 1]
     catch {$w delete $x}
}

# selection_if_any - return selection if it exists, else {}
#   this is from kjx@comp.vuw.ac.nz (R. James Noble)
proc selection_if_any {} {
  if {[catch {selection get} s]} {return ""} {return $s}
}

proc bind_cleanup { w } {
  global btp
  if {[info exists btp($w,markring)]} {
    unset btp($w,markring)
  }
}

proc bt:current-line { w } {
    return [lindex [split [$w index insert] .] 0]
}

proc bt:current-col { w {mods {}} } {
    return [lindex [split [$w index "insert $mods"] .] 1]
}

proc bt:what-line { ndx } {
  return [lindex [split $ndx .] 0]
}

proc bt:what-col { ndx } {
  return [lindex [split $ndx .] 1]
}

proc bt:move-line { w {num 1} } {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {$btp(prevcmd) != "move-line"} {
        set btp(goalcol) [bt:what-col [$w index insert]]
    }
    if {$num > -1} {set num "+$num"}
    set ndx [$w index "insert $num line lineend"]
    set goalndx [bt:what-line $ndx].$btp(goalcol)
    if {$btp(goalcol) < [bt:what-col $ndx]} {
        $w mark set insert $goalndx
    } else {
        $w mark set insert $ndx
    }
    bind_textAdjsel $w
    $w yview -pickplace insert
    set btp(prevcmd) move-line
}

proc bt:move-char { w {num 1} } {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {$num > -1} {set num "+$num"}
    $w mark set insert "insert $num char"
    bind_textAdjsel $w
    $w yview -pickplace insert
    set btp(prevcmd) "move-char"
}

proc bt:move-word {w {num 1}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {$num > 0} {
        for {set i 0} {$i < $num } {incr i} {
	    while {[regexp $btp(not-word) [$w get insert]] &&
		   [$w compare insert < end]} {
	        $w mark set insert insert+1c
	    } 
	    $w mark set insert {insert wordend}
	}
    } else {
        for {set i 0} {$i > $num } {incr i -1} {
	    $w mark set insert insert-1c
	    while {[regexp $btp(not-word) [$w get insert]] &&
		   [$w compare insert > 1.0]} {
	        $w mark set insert insert-1c
	    } 
	    $w mark set insert {insert wordstart}
	}
    }
    bind_textAdjsel $w
    $w yview -pickplace insert
    set btp(prevcmd) "move-word"
}

proc bt:move-para {w {num 1}} {
  global btp

  if {$btp(arg) != "def"} {
    set num [expr $num*$btp(arg)]
    set btp(arg) def
  }
  if {$num > 0} {
    for {set i 0} {$i < $num } {incr i} {
      while {[string trim [$w get insert "insert lineend"]] != "" &&
	     [$w compare "insert lineend" < end]} {
	$w mark set insert "insert linestart +1 line"
      }
      while {[string trim [$w get insert "insert lineend"]] == "" &&
	     [$w compare "insert lineend" < end]} {
	$w mark set insert "insert linestart +1 line"
      }
    }
    if [$w compare "insert lineend" == end] {
      $w mark set insert end
    }
  } else {
    for {set i 0} {$i > $num } {incr i -1} {
      $w mark set insert "insert -1 char linestart"
      while {[string trim [$w get insert "insert lineend"]] == "" &&
	     [$w compare "insert linestart" > 1.0]} {
	$w mark set insert "insert linestart -1 line"
      }
      while {[string trim [$w get insert "insert lineend"]] != "" &&
	     [$w compare "insert linestart" > 1.0]} {
	$w mark set insert "insert linestart -1 line"
      }
      if {[string trim [$w get insert "insert lineend"]] == ""} {
	$w mark set insert "insert linestart +1 line"
      }
    }
  }
  bind_textAdjsel $w
  $w yview -pickplace insert
  set btp(prevcmd) "move-para"
}

proc bt:begin-line { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$num != 0} {set num [expr $num-1]}
    bt:move-line $w $num
    $w mark set insert {insert linestart}
    bind_textAdjsel $w
    $w yview -pickplace insert
    set btp(prevcmd) "begin-line"
}

proc bt:end-line { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$num != 0} {set num [expr $num-1]}
    bt:move-line $w $num
    $w mark set insert {insert lineend}
    bind_textAdjsel $w
    $w yview -pickplace insert
    set btp(prevcmd) end-line
}

proc bt:begin-buffer { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    # bt:set-mark $w
    set ndx [expr 1+[bt:what-line [$w index end]]*$num/10]
    $w mark set insert $ndx.0
    bind_textAdjsel $w
    $w yview -pickplace insert
    set btp(prevcmd) begin-buffer
}

proc bt:end-buffer { w {num 0}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    # bt:set-mark $w
    set ndx [expr [bt:what-line [$w index end]]*$num/10]
    $w mark set insert "end - $ndx lines"
    bind_textAdjsel $w
    $w yview -pickplace insert
    set btp(prevcmd) end-buffer
}

proc bt:scroll-next { w {num 1}} {
    global  btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    set scr [lindex [lindex [$w configure -yscroll] 4] 0]
    $w mark set insert [lindex [$scr get] 3].0
    bind_textAdjsel $w
    $w yview insert-1l
    set btp(prevcmd) scroll-next
}

proc bt:scroll-prior { w {num 1}} {
    global btp
    set btp(lastkill) 0.0
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    set scr [lindex [lindex [$w configure -yscroll] 4] 0]
    set tndx [expr [lindex [$scr get] 2]-[lindex [$scr get] 1]+5].0
    if {$tndx < 1.0} {set tndx 1.0}
    $w mark set insert $tndx
    bind_textAdjsel $w
    $w yview insert-1l
    set btp(prevcmd) scroll-prior
}

proc bt:delete-word { w {num 1}} {
    global btp
    bind_textUnsel $w
    if {[$w compare $btp(lastkill) == insert]} {
	set where 1
    } else { set where 0 }
    set beg [$w index insert]
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    bt:move-word $w $num
    if {[$w compare $beg < [$w index insert]]} {
        bt:push-cut [bt:copy-with-tags $w $beg insert] $where
        bt:text-delete $w $beg insert
    } else {
        bt:push-cut [bt:copy-with-tags $w insert $beg] [expr -1*$where]
        bt:text-delete $w insert $beg
    }
    set btp(lastkill) [$w index insert]
    $w yview -pickplace insert
    set btp(prevcmd) delete-word
}

proc bt:delete-line { w {num 0}} {
  global btp
  bind_textUnsel $w
  if {$btp(arg) != "def"} {
    set num $btp(arg)
    set btp(arg) def
  }
  if {[$w compare $btp(lastkill) == insert]} {
    set where 1
  } else { set where 0 }
  if {[string length [$w get  insert "insert lineend"]] == 0 \
	  && $num == 0} { set num 1 }
  set beg [$w index insert]
  if {$num != 0} {
    bt:move-line $w $num
    bt:begin-line $w
    if {[$w compare $beg < [$w index insert]]} {
      bt:push-cut [bt:copy-with-tags $w $beg insert] $where
      bt:text-delete $w $beg insert
    } else {
      bt:push-cut [bt:copy-with-tags $w insert $beg] [expr -1*$where]
      bt:text-delete $w insert $beg
    }
  } else {
    bt:push-cut [bt:copy-with-tags $w insert {insert lineend}] $where
    bt:text-delete $w insert {insert lineend}
    $w yview -pickplace insert
  }
  $w yview -pickplace insert
  set btp(lastkill) [$w index insert]
  set btp(prevcmd) delete-line
}

proc bt:delete-back-char-or-sel { w {num 1} } {
    global btp
    if {$btp(arg) != "def"} {
        set num $btp(arg)
    } else {set btp(lastkill) 0.0}
    set num [expr -1*$num]
    if {$num > -1} {set num "+$num"}
    if {[$w compare $btp(lastkill) == insert]} {
	set where 1
    } else { set where 0}
    if {![bind_textCutsel $w]} {
        if {$btp(arg) != "def"} {
	    if {$num < 0} {
	      bt:push-cut [bt:copy-with-tags $w "insert $num char" insert] [expr -1*$where]
	      bt:text-delete $w "insert $num char" insert
	    } else {
	      bt:push-cut [bt:copy-with-tags $w insert "insert $num char"] $where
	      bt:text-delete $w insert "insert $num char"
	    }
	    set btp(lastkill) [$w index insert]
        } else {
	    if {$num < 0} {
	        bt:text-delete $w "insert $num char" insert
	    } else {
	        bt:text-delete $w insert "insert $num char"
	    }
	    set btp(lastkill) 0.0
        }
    }
    set btp(arg) def
    $w yview -pickplace insert
    set btp(prevcmd) delete-back-char-or-sel
}

proc bt:delete-horiz-space { w } {
  global btp
  bind_textUnsel $w
  set btp(arg) def

  $w mark set emacs "insert"
  while {[string match "\[ \t\]" [$w get "emacs -1 char"]]} {
    $w mark set emacs "emacs -1 char"
  }
  while {[string match "\[ \t\]" [$w get insert]]} {
    $w mark set insert "insert +1 char"
  }
  if {[$w compare insert > emacs]} {
    bt:delete-region-or-sel $w
  }
}

proc bt:delete-region-or-sel { w } {
    global btp

    if {![bind_textCutsel $w]} {
	if {[catch "$w index emacs"]} {
	    $btp(error) "No emacs mark has been set yet!" $w
	    return
	}
        if {[$w compare $btp(lastkill) == insert]} {
	  set where 1
        } else { set where 0}
	if {[$w compare emacs < insert]} {
	  bt:push-cut [bt:copy-with-tags $w emacs insert] $where
	  bt:text-delete $w emacs insert
	} else {
	  bt:push-cut [bt:copy-with-tags $w insert emacs] [expr -1*$where]
	  bt:text-delete $w insert emacs
	}
        set btp(lastkill) [$w index insert]
    }
    set btp(arg) def
    set btp(prevcmd) delete-region-or-sel
}

proc bt:copy-region-or-sel { w } {
    global btp

    if {[catch {$w get sel.first}]} {
	if {[catch "$w index emacs"]} {
	    $btp(error) "No emacs mark has been set yet!" $w
	    return
	}
        if {[$w compare $btp(lastkill) == insert]} {
	  set where 1
        } else { set where 0}
	if {[$w compare emacs < insert]} {
	  bt:push-cut [bt:copy-with-tags $w emacs insert] $where
	} else {
	  bt:push-cut [bt:copy-with-tags $w insert emacs] [expr -1*$where]
	}
	bt:exchange-point-and-mark $w
	after 200 bt:exchange-point-and-mark $w
    } else {
      bt:push-cut [bt:copy-with-tags $w sel.first sel.last]
    }
    set btp(arg) def
    set btp(lastkill) 0.0
    set btp(prevcmd) copy-region-or-sel
}

proc bt:append-next-kill { w } {
    global btp
    set btp(lastkill) [$w index insert]
}

proc bt:copy-with-tags { w start stop } {
  global btp

  set tagspecs {}
  set start [$w index $start]
  foreach tagname [$w tag names] {
    set tmp $start
    set rng xxx
    set rng [$w tag nextrange $tagname $tmp $stop]
    while {[llength $rng]} {
      lappend tagspecs [bt:get-offsets $tagname $start $rng]
      set tmp [lindex $rng 1]
      set rng [$w tag nextrange $tagname $tmp $stop]
    }
  }
  return [list [$w get $start $stop] $tagspecs]
}

proc bt:get-offsets {tagname anchor rng} {

  set tmp [split $anchor .]
  set aline [lindex $tmp 0]
  set achar [lindex $tmp 1]

  set tmp [split [lindex $rng 0] .]
  set bline [lindex $tmp 0]
  set bchar [lindex $tmp 1]

  set tmp [split [lindex $rng 1] .]
  set eline [lindex $tmp 0]
  set echar [lindex $tmp 1]

  if {$aline == $bline} {
    set boffset "+ [expr $bchar-$achar] c"
  } else {
    set boffset "+ [expr $bline-$aline] l linestart + $bchar c"
  }

  if {$aline == $eline} {
    set eoffset "+ [expr $echar-$achar] c"
  } else {
    set eoffset "+ [expr $eline-$aline] l linestart + $echar c"
  }
  return [list $tagname $boffset $eoffset]
}

proc bt:paste-with-tags { w cutbuf {all 0} } {
  global btp

  set index [$w index insert]

  while {[llength $cutbuf]} {

    set start [$w index insert]
    $w insert insert [lvarpop cutbuf]
    foreach tagname [$w tag names] {
      $w tag remove $tagname $start insert
    }

    set tagspecs [lvarpop cutbuf]
    foreach tagspec $tagspecs {
      set tagname [lindex $tagspec 0]
      if {!$all && [lsearch -exact $btp(copy-tags) $tagname] < 0} continue
      set boffset [lindex $tagspec 1]
      set eoffset [lindex $tagspec 2]

      $w tag add $tagname "$start $boffset" "$start $eoffset"
    }
  }

  if {!$all} { bt:undo-push $w {} $index [$w index insert] }
  $w mark set emacs $index
}

proc bt:replace-with-tags { w cutbuf first last {all 0} } {
  if {[catch "set first \[$w index \$first\]"]} {return 1}
  if {[catch "set last \[$w index \$last\]"]} {return 1}
  set tmpcut [bt:copy-with-tags $w $first $last]
  $w delete $first $last
  $w mark set insert $first
  bt:paste-with-tags $w $cutbuf $all
  bt:undo-push $w $tmpcut $first [$w index insert]
  $w mark set emacs $first
  return 0
}

proc bt:push-cut { thiscut {where 0} } {
  global btp

  if $where {
    set lastcut [lvarpop btp(killring) end]
    if {$where < 0 } {
      lappend btp(killring) [concat $thiscut $lastcut]
    } else {
      lappend btp(killring) [concat $lastcut $thiscut]
    }
  } else {    
    set btp(killlen) [llength [lappend btp(killring) $thiscut]]
    if { $btp(killlen) > $btp(maxkill)} {
	incr btp(killlen) -1
	lvarpop btp(killring)
    }
  }
  set btp(killptr) 0
}

proc bt:pop-cut { } {
    global btp

    if {$btp(killlen) == 0} {return ""}
    set lastcut [lvarpop btp(killring) end]
    incr btp(killlen) -1
    set btp(killptr) 0
    return $lastcut
}

proc bt:get-cut { {ndx 1} } {
    global btp

    if {$btp(killlen) == 0} {return ""}
    set ndx [expr $ndx+$btp(killptr)]
    set btp(killptr) [expr $ndx-1]
    set ndx [expr $ndx%$btp(killlen)]
    if {$ndx == 0} {set ndx $btp(killlen)}
    return [lindex $btp(killring) [expr $btp(killlen)-$ndx]]
}

proc bt:get-cut-text { {ndx 1} } {
  set cutbuf [bt:get-cut $ndx]
  set txt {}
  while {[llength $cutbuf]} {
    append txt [lvarpop cutbuf]
    lvarpop cutbuf
  }
  return $txt
}

proc bt:yank { w {num 1}} {
    global btp
    bind_textUnsel $w
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    set btp(lastkill) 0.0
    bt:paste-with-tags $w [bt:get-cut $num]
    $w yview -pickplace insert
    set btp(prevcmd) yank
}

proc bt:yank-pop { w {num 1}} {
    global btp
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$btp(prevcmd) != "yank"} return
    bind_textUnsel $w
    bt:replace-with-tags $w [bt:get-cut [expr $num+1]] emacs insert
    $w yview -pickplace insert
}

proc bt:pop-mark { w } {
    global btp
    set ndx [expr [llength $btp($w,markring)]-1]
    set oldmark [lindex $btp($w,markring) $ndx]
    $w mark set emacs $oldmark
    set btp($w,markring) [concat $oldmark [lreplace $btp($w,markring) $ndx $ndx]]
}

proc bt:push-mark { w ndx } {
    global btp
    lappend btp($w,markring) $ndx
}

proc bt:mark-whole-buffer { w } {
    global btp tk_priv
    $w mark set insert end
    bt:set-mark $w
    $w mark set insert 1.0
    $w tag add sel 1.0 end
    $w tag raise sel
    $w yview insert
}
 
proc bt:mark-region { w start stop } {
    global btp tk_priv
    $w mark set insert $stop
    bt:set-mark $w
    $w mark set insert $start
    $w tag add sel $start $stop
    $w tag raise sel
    $w yview insert
}
 
proc bt:set-mark { w {num def}} {
    global btp tk_priv
    bind_textUnsel $w
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$num != "def"} {
	if {[catch "$w index emacs"]} {
	    $btp(error) "No emacs mark has been set yet!" $w
	    return
	}
        $w yview -pickplace insert
        bt:pop-mark $w
        $w mark set insert emacs
    } else {
	bt:push-mark $w [$w index insert]
        $w mark set emacs insert
	if {$btp(transient-mark)} {
	    if {[lindex [$w tag configure sel -relief] 4] == "raised"} {
		bind_makeXtag $w
	    }
	    if {[lindex [$w tag configure sel -relief] 4] != "raised"} {
	      foreach opt {-background -bgstipple -borderwidth -fgstipple \
		      -font -foreground -underline} {
		  $w tag configure sel $opt \
		      [lindex [$w tag configure xsel $opt] 4]
	      }
	      $w tag configure sel -relief raised
	    }
	    set btp(mark-active) 1
	}
    }
    set btp(lastkill) 0.0
    set btp(prevcmd) set-mark
}

proc bt:exchange-point-and-mark { w } {
    global btp
    if {[catch "$w index emacs"]} {
	$btp(error) "No emacs mark has been set yet!" $w
	return
    }
    set tmp [$w index insert]
    $w mark set insert emacs
    $w mark set emacs $tmp
    set btp(lastkill) 0.0
    set btp(prevcmd) set-mark
}

proc bt:open-line {w {num 1}} {
    global btp
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    bind_textDelsel $w
    for {set i 0} {$i < $num } {incr i} {
        $w insert insert \n
    }
    $w mark set insert insert-1c
    $w yview -pickplace insert
    set btp(prevcmd) open-line
}

proc bt:keyboard-quit { w } {
    global btp
    bind_textUnsel $w
    set btp(arg) "def"
}

proc bt:argkey { w a } {
    global btp
    set btp(arg) $a
} 

proc bt:numkey { w a } {
    global btp
    if {$btp(arg) == "def"} {
	bind_textDelsel $w
	bt:self-insert $w $a
	$w yview -pickplace insert
	set btp(lastkill) 0.0
	set btp(prevcmd) self-insert
    } else {
	if {$a == "-"} {
	    if {$btp(arg) == "-"} { 
		set btp(arg) "0" 
	    } elseif {$btp(arg) == "0"} {
		set btp(arg) "-"
	    } else {
		set btp(arg) [expr -1*$btp(arg)]
	    }
	} else {
	    append btp(arg) $a
	}
    }
} 

proc bt:univ-arg { w } {
    global btp
    if {$btp(arg) == "def"} {
	set btp(arg) 4
    } else {
	if {$btp(arg) == "-"} { 
	    set btp(arg) "-4" 
	} else {
	    set btp(arg) [expr 4*$btp(arg)]
	}
    }
}

proc bt:set-fill-col { w {num 0}} {
    global btp
    if {$btp(arg) == "def"} {
	if {$num < 1} {
	    set btp(fillcol) [bt:current-col $w]
	} else {
	    set btp(fillcol) $num
	}
    } else {
	if {$btp(arg) < 1} {
	    set btp(fillcol) [bt:current-col $w]
	} else {
	    set btp(fillcol) $btp(arg)
	}
    }
    set btp(arg) def
    set btp(lastkill) 0.0
    set btp(prevcmd) set-fill-col
}

# only one mouse, so no need have separate vars for each widget
set bind_xnd(txnd) 0
set bind_xnd(xdelay) 100
set bind_xnd(b2-time) 0
set bind_xnd(b2-y) 0
set bind_xnd(mxpos) 0
set bind_xnd(mypos) 0

proc bind_textB1motion  { w loc } {
    global bind_xnd btp

    set xpos [lindex [split $loc ","] 0]
    set ypos [lindex [split $loc ","] 1]
    if {abs($xpos-$bind_xnd(mxpos)) < $btp(mouse-motion)  && 
	abs($ypos-$bind_xnd(mypos)) < $btp(mouse-motion)} {
      return
    }
    set bind_xnd(mxpos) -100
    set bind_xnd(mypos) -100

    if {$ypos > [winfo height $w]} {
	    if {!$bind_xnd(txnd)} {after $bind_xnd(xdelay) bind_textExtend $w}
	    set bind_xnd(txnd) 1
	    set bind_xnd(direction) down
    } elseif {$ypos < 0} {
	    if {!$bind_xnd(txnd)} {after $bind_xnd(xdelay) bind_textExtend $w}
	    set bind_xnd(txnd) 1
	    set bind_xnd(direction) up
    } else {
	    set bind_xnd(txnd) 0
	    set bind_xnd(direction) 0
    }

    if {!$bind_xnd(txnd)} {
	    bind_textSelectTo $w @$loc
    }

}

proc bind_makeXtag { tw } {
    global btp
    foreach opt {-background -bgstipple -borderwidth -fgstipple \
	    -font -foreground -underline} {
	$tw tag configure xsel $opt \
	    [lindex [$tw tag configure sel $opt] 4]
	$tw tag configure sel $opt \
	    [lindex [$tw tag configure none $opt] 4]
    }
    $tw tag configure sel -relief flat
    $tw tag configure xsel -relief raised
    set btp($tw,madetag) 1
}

proc bind_textSelectTo {tw index} {
    global tk_priv

    if {[lindex [$tw tag configure sel -relief] 4] != "raised"} {
      foreach opt {-background -bgstipple -borderwidth -fgstipple \
	      -font -foreground -underline} {
	  $tw tag configure sel $opt \
	      [lindex [$tw tag configure xsel $opt] 4]
      }
      $tw tag configure sel -relief raised
    }

    tk_textSelectTo $tw $index
    $tw tag raise sel
}

proc bind_textResetAnchor {w index} {
    global tk_priv
    if {[$w tag ranges sel] == ""} {
        set tk_priv(selectMode) char
        $w mark set anchor insert
        return
    }
    if [tk_textIndexCloser $w $index sel.first sel.last] {
        if {$tk_priv(selectMode) == "char"} {
            $w mark set anchor sel.last
        } else {
            $w mark set anchor sel.last-1c
        }
    } else {
        $w mark set anchor sel.first
    }
}

proc bt:undo-init { w } {
    global btp
    set btp($w,undo-cnt) 0
    set btp($w,undo-cut) {}
    set btp($w,undo-first) -1.0
    set btp($w,undo-last) -1.0
    set btp($w,undo-list) {}
}

proc bt:undo-push { w utext first last } {
    global btp

    if {![info exists btp($w,undo-cnt)]} {
	bt:undo-init $w
    }

    lvarpush btp($w,undo-list) [list $btp($w,undo-cut) \
	    $btp($w,undo-first) $btp($w,undo-last)]
    set btp($w,undo-cut) $utext
    set btp($w,undo-first) $first
    set btp($w,undo-last) $last

    if {$btp($w,undo-cnt) >= $btp(undo-level)} {
	lvarpop btp($w,undo-list) end
    } else {
	incr btp($w,undo-cnt)
    }
}

proc bt:undo-pop { w } {
    global btp

    if {![info exists btp($w,undo-cnt)]} {
	bt:undo-init $w
    }
    if {$btp($w,undo-cnt) == 0} {
	eval $btp(beep)
	return
    }

    $w mark set insert $btp($w,undo-first)
    $w delete insert $btp($w,undo-last)
    bt:paste-with-tags $w $btp($w,undo-cut) 1

    set upop [lvarpop btp($w,undo-list)]
    lassign $upop btp($w,undo-cut) btp($w,undo-first) btp($w,undo-last)

    incr btp($w,undo-cnt) -1
    set btp(prevcmd) undo-pop

}

proc bt:self-insert { w txt } {
    global btp

    if {$btp(prevcmd) != "self-insert"} {
	set ndx [$w index insert]
	bt:undo-push $w {} $ndx $ndx
    }
    $w insert insert $txt

    if {$btp(fillcol) && [bt:current-col $w] > $btp(fillcol)} {
      $w mark set fillstart insert
      $w mark set insert "insert linestart + [expr $btp(fillcol)+1] chars"
      bt:wrap-word $w
      $w mark set insert fillstart
    }	

    set btp($w,undo-last) [$w index insert]
    set btp(prevcmd) self-insert
    return 0
}

proc bt:event-self-insert { w key } {
    global btp
    set num 1
    if {$key != ""} {
	if {$btp(arg) != "def"} {
	    set num $btp(arg)
	    set btp(arg) def
	}
	bind_textDelsel $w
	for {set i 0} { $i < $num} {incr i} {bt:self-insert $w $key}
	$w yview -pickplace insert
	set btp(lastkill) 0.0
	set btp(prevcmd) self-insert
    }
}

proc bt:wrap-word { w } {
  global btp

  if {[string first [$w get "insert -1 c"] " \t"] < 0} {
    $w mark set insert insert-1c
    while {![regexp $btp(not-word) [$w get insert]] &&
	   [$w compare insert > 1.0]} {
      $w mark set insert insert-1c
    } 
    $w mark set insert insert+1c
  }
  if {[$w compare insert > "insert linestart"]} {
    set ndx [$w index insert]
    $w insert insert \n
    bt:undo-push $w {} $ndx [$w index insert]
  }
}

proc bt:format-para { w {linemark {}} } {
    global btp

  if {$btp(fillcol)} { set fcol $btp(fillcol) } else { set fcol 70 }

  bt:move-para $w 1
  if {[$w compare "insert lineend" < end]} {
    $w mark set insert "insert -1 line"
  }
  while {[string trim [$w get insert "insert lineend"]] == "" &&
	 [$w compare insert > 1.0]} {
    $w mark set insert "insert -1 line"
  }
  set last [$w index "insert lineend"]

  if [string length $linemark] {
    $w mark set insert "$linemark linestart"
  } else {
    bt:move-para $w -1
  }
  set first [$w index insert]
  while {[string match "\[ \t]" [$w get insert]] &&
	 [$w compare insert < end]} {
    $w mark set insert "insert +1 char"
  }
  if {[$w compare insert != $first]} {
    set prefix [$w get $first insert]
  } else { set prefix ""}

  set txt [bt:format-str [string trim [$w get $first $last]] $fcol $prefix]
  bt:text-replace $w $txt $first $last

  $w yview -pickplace insert
  set btp(prevcmd) "format-para"
}

proc bt:format-str { txt fcol prefix} {

  regsub -all "\[ \t]*\n\[ \t]*" $txt { } txt
  set ntxt {}
  incr fcol -[string length $prefix]

  while {[string length $txt] > $fcol} {
    set ttxt [string range $txt 0 $fcol]
    set lspc [string last " " $ttxt]
    set ltab [string last "\t" $ttxt]
    if {$lspc == -1 && $ltab == -1} {
      set lspc [string first " " $txt]
      set ltab [string first "\t" $txt]
      if {$lspc < $ltab && $lspc != -1} {
	append ntxt "$prefix[string range $txt 0 $lspc]\n"
	set txt [string trim [string range $txt $lspc end]]
      } elseif {$ltab < $lspc && $ltab != -1} {
	append ntxt "$prefix[string range $txt 0 $ltab]\n"
	set txt [string trim [string range $txt $ltab end]]
      } else {
	append ntxt "$prefix$txt\n"
	set txt {}
      }
    } elseif {$lspc > $ltab} {
      append ntxt "$prefix[string range $txt 0 $lspc]\n"
      set txt [string trim [string range $txt $lspc end]]
    } else {
      append ntxt "$prefix[string range $txt 0 $ltab]\n"
      set txt [string trim [string range $txt $ltab end]]
    }
  }

  append ntxt "$prefix$txt"
  
  return $ntxt
}

proc bt:text-delete { w first last } {
    if {[catch "set first \[$w index \$first\]"]} {return 1}
    if {[catch "set last \[$w index \$last\]"]} {return 1}
    bt:undo-push $w [bt:copy-with-tags $w $first $last] $first $first
    $w delete $first $last
    return 0
}

proc bt:text-insert { w txt } {
    set ndx [$w index insert]
    $w insert insert $txt
    bt:undo-push $w {} $ndx [$w index insert]
    $w mark set emacs $ndx
    return 0
}

proc bt:text-replace { w txt first last } {
    if {[catch "set first \[$w index \$first\]"]} {return 1}
    if {[catch "set last \[$w index \$last\]"]} {return 1}
    set tmpcut [bt:copy-with-tags $w $first $last]
    $w delete $first $last
    $w mark set insert $first
    $w insert $first $txt
    bt:undo-push $w $tmpcut $first [$w index insert]
    $w mark set emacs $first
    return 0
}

proc bind_textDelsel { tw } {
    global btp

    set btp(mark-active) 0
    if {[lindex [$tw tag configure sel -relief] 4] == "raised"} {
      bt:text-delete $tw sel.first sel.last
    }
}

proc bind_textCutsel { tw } {
  global btp

  set btp(mark-active) 0
  if {![catch {$tw get sel.first}] &&
      [lindex [$tw tag configure sel -relief] 4] == "raised"} {
    bt:push-cut [bt:copy-with-tags $tw sel.first sel.last]
    bt:text-delete $tw sel.first sel.last
    set btp(lastkill) 0.0
    return 1
  } else {return 0}
}

proc bind_textUnsel { tw } {
    global btp

    if {[lindex [$tw tag configure xsel -relief] 4] != "raised"} {
      foreach opt {-background -bgstipple -borderwidth -fgstipple \
	      -font -foreground -underline} {
	  $tw tag configure xsel $opt \
	      [lindex [$tw tag configure sel $opt] 4]
      }
      $tw tag configure xsel -relief raised
    }
    foreach opt {-background -bgstipple -borderwidth -fgstipple \
	    -font -foreground -underline} {
	$tw tag configure sel $opt \
	    [lindex [$tw tag configure none $opt] 4]
    }
    $tw tag configure sel -relief flat
    set btp(mark-active) 0
}

proc bind_textAdjsel { tw } {
    global btp

    $tw tag remove sel 0.0 end
    if {$btp(mark-active)} {
	set mark [$tw index emacs]
	set ndx [$tw index insert]
	if { $ndx < $mark } {
	    $tw tag add sel $ndx $mark
	} else {
	    $tw tag add sel $mark $ndx
	}
	$tw tag raise sel
    }
    
}

proc bt:shift-move { tw args } {
  global btp

  if {[lindex [$tw tag configure sel -relief] 4] != "raised" ||
      [lindex [$tw tag configure xsel -relief] 4] != "raised" ||
      [llength [$tw tag ranges sel]] == 0} {
    bt:set-mark $tw
  }
  set btp(mark-active) 1
  eval $args
  set btp(mark-active) 0
}

proc bind_textExtend { tw } {
     global bind_xnd

     if {$bind_xnd(txnd)} {
	 if {$bind_xnd(direction) == "down"} {
	     bind_textSelectTo $tw sel.last+1l
	     $tw yview -pickplace sel.last+1l
	 } elseif {$bind_xnd(direction) == "up"} {
	     bind_textSelectTo $tw sel.first-1l
	     $tw yview -pickplace sel.first-1l
	 } else { return }
	 after $bind_xnd(xdelay) bind_textExtend $tw
     }
}

proc bind_motiftext { tw } {
    global bind_xnd

    bind $tw <Control-KeyPress> {
        global btp
	if {"%A" != ""} {eval $btp(beep) }
    }

    # Some better bindings for text and entry
    bind $tw <Up> {bt:move-line %W -1}
    bind $tw <Down> {bt:move-line %W 1}
    bind $tw <Left> {bt:move-char %W -1}
    bind $tw <Right> {bt:move-char %W 1}
    bind $tw <Home> {bt:begin-line %W}
    bind $tw <End> {bt:end-line %W}
    bind $tw <Control-Home> {bt:begin-buffer %W}
    bind $tw <Control-End> {bt:end-buffer %W}
    bind $tw <Control-Left> {bt:move-word %W -1}
    bind $tw <Control-Right> {bt:move-word %W 1}
    bind $tw <Control-Next> {bt:move-para %W 1}
    bind $tw <Control-Prior> {bt:move-para %W -1}
    bind $tw <Next> {bt:scroll-next %W}
    bind $tw <Prior> {bt:scroll-prior %W}

    bind $tw <Any-KeyPress> {bt:event-self-insert %W %A}

    bind $tw <KeyPress-Return> {
	global btp
        bind_textDelsel %W
	set num 1
	if {$btp(arg) != "def"} {
	    set num $btp(arg)
	    set btp(arg) def
	}
        for {set i 0} { $i < $num} {incr i} {bt:self-insert %W "\n"}
        %W yview -pickplace insert
	set btp(lastkill) 0.0
	set btp(prevcmd) newline
    }

    bind $tw <KeyPress-Delete> {bt:delete-back-char-or-sel %W 1}
    bind $tw <KeyPress-BackSpace> {bt:delete-back-char-or-sel %W 1}

    bind $tw <1> {
	global btp tk_priv
	set tk_priv(selectMode) char
	bind_textUnsel %W
	%W mark set insert @%x,%y
	%W mark set anchor insert
	if {[lindex [%W config -state] 4] == "normal"} {focus %W}
	set btp(lastkill) 0.0
	set btp(prevcmd) mouse-set
        set bind_xnd(mxpos) %x
        set bind_xnd(mypos) %y
    }
    bind $tw <Double-1> {
	set tk_priv(selectMode) word
	%W mark set insert "@%x,%y wordstart"
	bind_textSelectTo %W insert
    }
    bind $tw <Triple-1> {
	set tk_priv(selectMode) line
	%W mark set insert "@%x,%y linestart"
	bind_textSelectTo %W insert
    }

    bind $tw <B1-Motion> {bind_textB1motion %W %x,%y}
    bind $tw <Shift-1> {
	bind_textResetAnchor %W @%x,%y
	bind_textSelectTo %W @%x,%y
    }
    bind $tw <Shift-B1-Motion> {bind_textB1motion %W %x,%y}

    bind $tw <ButtonRelease-1> { 
        global bind_xnd btp
        set bind_xnd(txnd) 0
	set btp(lastkill) 0.0
	set btp(prevcmd) mouse-select
    }

    bind $tw <2> {
        global bind_xnd
        %W scan mark %y
        set bind_xnd(b2-time) %t
        set bind_xnd(b2-y) %y
    }
    bind $tw <ButtonRelease-2> {
        global bind_xnd btp
	if {[expr %t-$bind_xnd(b2-time)]<$btp(time-to-scan)} {
	    bt:text-insert %W [selection_if_any]
	    set btp(lastkill) 0.0
	    set btp(prevcmd) mouse-insert
        }
    }

    bind $tw <3> {bt:keyboard-quit %W}

}

proc bind_emacstext { tw } {
    global btp

    bind $tw <Control-a> {bt:begin-line %W}
    bind $tw <Control-e> {bt:end-line %W}
    bind $tw <Control-f> {bt:move-char %W 1}
    bind $tw <Control-b> {bt:move-char %W -1}

    bind $tw <Control-n> {bt:move-line %W 1}
    bind $tw <Control-p> {bt:move-line %W -1}
    bind $tw <Control-l> {
	%W yview -pickplace insert
    }
    bind $tw <Control-o> {bt:open-line %W 1}
    bind $tw <Control-d> {bt:delete-back-char-or-sel %W -1}

    bind $tw <Control-h> {bt:delete-back-char-or-sel %W -1}

    bind $tw <Control-k> {bt:delete-line %W 0}
    bind $tw <Control-w> {bt:delete-region-or-sel %W}
    bind $tw <Control-y> {bt:yank %W}
    bind $tw <Control-space> {bt:set-mark %W}
    bind $tw <Control-underscore> {bt:undo-pop %W}

    bind $tw <Control-g> {bt:keyboard-quit %W}
    bind $tw <Control-u> {bt:univ-arg %W}
    bind $tw <KeyPress-0> {bt:numkey %W %A}
    bind $tw <KeyPress-1> {bt:numkey %W %A}
    bind $tw <KeyPress-2> {bt:numkey %W %A}
    bind $tw <KeyPress-3> {bt:numkey %W %A}
    bind $tw <KeyPress-4> {bt:numkey %W %A}
    bind $tw <KeyPress-5> {bt:numkey %W %A}
    bind $tw <KeyPress-6> {bt:numkey %W %A}
    bind $tw <KeyPress-7> {bt:numkey %W %A}
    bind $tw <KeyPress-8> {bt:numkey %W %A}
    bind $tw <KeyPress-9> {bt:numkey %W %A}

    bind $tw <Control-0> {bt:argkey %W %A}
    bind $tw <Control-1> {bt:argkey %W %A}
    bind $tw <Control-2> {bt:argkey %W %A}
    bind $tw <Control-3> {bt:argkey %W %A}
    bind $tw <Control-4> {bt:argkey %W %A}
    bind $tw <Control-5> {bt:argkey %W %A}
    bind $tw <Control-6> {bt:argkey %W %A}
    bind $tw <Control-7> {bt:argkey %W %A}
    bind $tw <Control-8> {bt:argkey %W %A}
    bind $tw <Control-9> {bt:argkey %W %A}
    bind $tw <Control-minus> {bt:argkey %W %A}

    # make C-x key a state
    bind $tw <Control-x> { }
    bind $tw <Control-x><Any-KeyPress> {
        global btp
	if {"%A" != ""} {eval $btp(beep) }
    }
    bind $tw <Control-x><Control-x> {bt:exchange-point-and-mark %W}
    bind $tw <Control-x><KeyPress-f> {bt:set-fill-col %W}
    bind $tw <Control-x><KeyPress-h> {bt:mark-whole-buffer %W}

    # make C-q key a state
    bind $tw <Control-q> { }
    bind $tw <Control-q><Any-KeyPress> {bt:event-self-insert %W %A}
    foreach k {a e f b n p l o d h k w g u x y space underscore \
		   minus 0 1 2 3 4 5 6 7 8 9} {
      bind $tw <Control-q><Control-KeyPress-$k> {bt:event-self-insert %W %A}
    }
    bind $tw <Control-q><Escape> {bt:event-self-insert %W %A}

    if {$btp(use-esc-prefix)} {
      # make Escape key simulate a state Alt key
      bind $tw <Escape> { }
      bind $tw <Escape><Any-KeyPress> {
	  global btp
	  if {"%A" != ""} {eval $btp(beep) }
      }

      bind $tw <Escape><f> {bt:move-word %W 1}
      bind $tw <Escape><b> {bt:move-word %W -1}
      bind $tw <Escape><bracketright> {bt:move-para %W 1}
      bind $tw <Escape><bracketleft> {bt:move-para %W -1}

      bind $tw <Escape><d> {bt:delete-word %W 1}
      bind $tw <Escape><backslash> {bt:delete-horiz-space %W}
      bind $tw <Escape><w> {bt:copy-region-or-sel %W}
      bind $tw <Escape><y> {bt:yank-pop %W}
      bind $tw <Escape><q> {bt:format-para %W}

      bind $tw <Escape><KeyPress-0> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-1> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-2> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-3> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-4> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-5> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-6> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-7> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-8> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-9> {bt:argkey %W %A}
      bind $tw <Escape><KeyPress-minus> {bt:argkey %W %A}

      foreach k {f b bracketright bracketleft d backslash w y q \
		   0 1 2 3 4 5 6 7 8 9 minus} {
	bind $tw <Control-q><Escape><$k> {bt:event-self-insert %W %A}
      }
    } else {
      bind $tw <Escape> {bt:keyboard-quit %W}
    }

    # Make Meta key like and Escape prefix
    if {$btp(use-meta)} {
	bind $tw <Meta-KeyPress> {
	    global btp
	    if {"%A" != ""} {eval $btp(beep) }
	}
	bind $tw <Control-Meta-KeyPress> {
	    global btp
	    if {"%A" != ""} {eval $btp(beep) }
	}

	bind $tw <Meta-f> {bt:move-word %W 1}
	bind $tw <Meta-b> {bt:move-word %W -1}
	bind $tw <Meta-d> {bt:delete-word %W 1}
        bind $tw <Meta-backslash> {bt:delete-horiz-space %W}
	bind $tw <Meta-w> {bt:copy-region-or-sel %W}
	bind $tw <Meta-y> {bt:yank-pop %W}
        bind $tw <Meta-q> {bt:format-para %W}

	bind $tw <Meta-0> {bt:argkey %W %A}
	bind $tw <Meta-1> {bt:argkey %W %A}
	bind $tw <Meta-2> {bt:argkey %W %A}
	bind $tw <Meta-3> {bt:argkey %W %A}
	bind $tw <Meta-4> {bt:argkey %W %A}
	bind $tw <Meta-5> {bt:argkey %W %A}
	bind $tw <Meta-6> {bt:argkey %W %A}
	bind $tw <Meta-7> {bt:argkey %W %A}
	bind $tw <Meta-8> {bt:argkey %W %A}
	bind $tw <Meta-9> {bt:argkey %W %A}
	bind $tw <Meta-minus> {bt:argkey %W %A}
    }
}

proc bind_mactext { tw } {
    global btp

    bind $tw <Control-a> {bt:mark-whole-buffer %W}
    bind $tw <Control-x> {bt:delete-region-or-sel %W}
    bind $tw <Control-c> {bt:copy-region-or-sel %W}
    bind $tw <Control-v> {bt:yank %W}
    bind $tw <Control-z> {bt:undo-pop %W}
    bind $tw <Escape> {bt:keyboard-quit %W}

    bind $tw <KeyPress-0> {bt:numkey %W %A}
    bind $tw <KeyPress-1> {bt:numkey %W %A}
    bind $tw <KeyPress-2> {bt:numkey %W %A}
    bind $tw <KeyPress-3> {bt:numkey %W %A}
    bind $tw <KeyPress-4> {bt:numkey %W %A}
    bind $tw <KeyPress-5> {bt:numkey %W %A}
    bind $tw <KeyPress-6> {bt:numkey %W %A}
    bind $tw <KeyPress-7> {bt:numkey %W %A}
    bind $tw <KeyPress-8> {bt:numkey %W %A}
    bind $tw <KeyPress-9> {bt:numkey %W %A}

    bind $tw <Control-0> {bt:argkey %W %A}
    bind $tw <Control-1> {bt:argkey %W %A}
    bind $tw <Control-2> {bt:argkey %W %A}
    bind $tw <Control-3> {bt:argkey %W %A}
    bind $tw <Control-4> {bt:argkey %W %A}
    bind $tw <Control-5> {bt:argkey %W %A}
    bind $tw <Control-6> {bt:argkey %W %A}
    bind $tw <Control-7> {bt:argkey %W %A}
    bind $tw <Control-8> {bt:argkey %W %A}
    bind $tw <Control-9> {bt:argkey %W %A}
    bind $tw <Control-minus> {bt:argkey %W %A}

    bind $tw <Control-period> {bt:set-fill-col %W}
    bind $tw <Control-j> {bt:format-para %W}

    bind $tw <Shift-Up> {bt:shift-move %W bt:move-line %W -1}
    bind $tw <Shift-Down> {bt:shift-move %W bt:move-line %W 1}
    bind $tw <Shift-Left> {bt:shift-move %W bt:move-char %W -1}
    bind $tw <Shift-Right> {bt:shift-move %W bt:move-char %W 1}
    bind $tw <Shift-Home> {bt:shift-move %W bt:begin-line %W}
    bind $tw <Shift-End> {bt:shift-move %W bt:end-line %W}
    bind $tw <Shift-Control-Home> {bt:shift-move %W bt:begin-buffer %W}
    bind $tw <Shift-Control-End> {bt:shift-move %W bt:end-buffer %W}
    bind $tw <Shift-Control-Left> {bt:shift-move %W bt:move-word %W -1}
    bind $tw <Shift-Control-Right> {bt:shift-move %W bt:move-word %W 1}
    bind $tw <Shift-Control-Next> {bt:shift-move %W bt:move-para %W 1}
    bind $tw <Shift-Control-Prior> {bt:shift-move %W bt:move-para %W -1}
    bind $tw <Shift-Next> {bt:shift-move %W bt:scroll-next %W}
    bind $tw <Shift-Prior> {bt:shift-move %W bt:scroll-prior %W}

}

##############
# ENTRY WIDGET
##############

proc be:move-char {w {num 1} } {
    global btp
    set btp(lastkill-entry) -1
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    $w select clear
    $w icursor [expr {[$w index insert] + $num}]
    tk_entrySeeCaret $w
    set btp(prevcmd) move-char
}

proc be:move-word {w {num 1}} {
    global btp
    set btp(lastkill-entry) -1
    $w select clear
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {$num > 0} {
        for {set i 0} {$i < $num } {incr i} {
	    set endx [expr [$w index insert]+1]
	    set estr [$w get]
	    while {$endx < [string length $estr] &&
	      [regexp $btp(not-word) [string index $estr $endx]]} {
	        incr endx
	    }
	    while {$endx < [string length $estr] &&
	      ![regexp $btp(not-word) [string index $estr $endx]]} {
	        incr endx
	    } 
	    $w icursor $endx
	}
    } else {
        for {set i 0} {$i > $num } {incr i -1} {
	    set endx [expr [$w index insert]-2]
	    set estr [$w get]
	    while {$endx > 0 &&
	       [regexp $btp(not-word) [string index $estr $endx]]} {
	        incr endx -1
	    }
	    while {$endx > 0 &&
	       ![regexp $btp(not-word) [string index $estr $endx]]} {
	        incr endx -1
	    }
	    if {$endx > 1} {incr endx}
	    $w icursor $endx
	}
    }
    tk_entrySeeCaret $w
    set btp(prevcmd) "move-word"
}

proc be:begin-line { w } {
    global btp
    set btp(lastkill-entry) -1
    $w select clear
    $w icursor 0
    tk_entrySeeCaret $w
    set btp(arg) def
    set btp(prevcmd) begin-line
}

proc be:end-line { w } {
    global btp
    set btp(lastkill-entry) -1
    $w select clear
    $w icursor end
    tk_entrySeeCaret $w
    set btp(arg) def
    set btp(prevcmd) end-line
}

proc be:delete-back-char-or-sel { w {num 1} } {
    global btp
    set btp(lastkill-entry) -1
    if {$btp(arg) != "def"} {
	set num [expr $num*$btp(arg)]
	set btp(arg) def
    }
    if {[catch {$w delete sel.first sel.last}] != 0} {
        set x [expr [$w index insert] - $num]
        catch {$w delete $x}
	tk_entrySeeCaret $w
    }
    set btp(prevcmd) delete-back-char-or-sel
}

proc be:delete-word { w {num 1}} {
    global btp
    $w select clear
    if {$btp(lastkill-entry) == [$w index insert]} {
	set where 1
    } else { set where 0 }
    set beg [$w index insert]
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    be:move-word $w $num
    set endx [$w index insert]
    if {$beg < $endx} {
      incr endx -1
      bt:push-cut [list [string range [$w get] $beg $endx] {}] $where
      $w delete $beg $endx
    } else {
      incr beg -1
      bt:push-cut [list [string range [$w get] $endx $beg] {}] [expr -1*$where]
      $w delete $endx $beg
    }
    set btp(lastkill-entry) [$w index insert]
    tk_entrySeeCaret $w
    set btp(prevcmd) delete-word
}

proc be:delete-line { w } {
    global btp
    if {$btp(lastkill-entry) == [$w index insert]} {
      set where 1
    } else { set where 0 }
    $w select clear
    bt:push-cut [list [string range [$w get] [$w index insert] end] {}] $where
    $w delete [$w index insert] end
    set btp(lastkill-entry) [$w index insert]
    tk_entrySeeCaret $w
    set btp(arg) def
    set btp(prevcmd) delete-line
}

proc be:delete-region-or-sel { w } {
    global btp
    if {[catch "$w index sel.first"]} {
	$btp(error) "Sorry! No emacs mark for entries yet!" $w
	return
    } else {
        bt:push-cut [list [selection_if_any] {}]
	$w delete sel.first sel.last
    }
    tk_entrySeeCaret $w
    set btp(lastkill-entry) -1
    set btp(arg) def
    set btp(prevcmd) delete-region-or-sel
}

proc be:copy-region-or-sel { w } {
    global btp
    if {[catch "$w index sel.first"]} {
	$btp(error) "Sorry! No emacs mark for entries yet!" $w
	return
    } else {
        bt:push-cut [list [selection_if_any] {}]
	$w select clear
    }
    tk_entrySeeCaret $w
    set btp(lastkill-entry) -1
    set btp(arg) def
    set btp(prevcmd) copy-region-or-sel
}

proc be:append-next-kill { w } {
    global btp
    set btp(lastkill-entry) [$w index insert]
}

proc be:yank { w {num 1}} {
    global btp
    $w select clear
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    set btp(lastkill-entry) -1
    set btp(entry-yank-mark) [$w index insert]
    $w insert insert [bt:get-cut-text $num]
    tk_entrySeeCaret $w
    set btp(prevcmd) yank
}

proc be:yank-pop { w {num 1}} {
    global btp
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {$btp(prevcmd) != "yank"} return
    $w select clear
    $w delete $btp(entry-yank-mark) [expr [$w index insert]-1]
    $w insert insert [bt:get-cut-text [expr $num+1]]
    tk_entrySeeCaret $w
}

proc be:set-mark { w } {
    global btp
    $btp(error) "Sorry! No emacs mark for entries yet!" $w
}


proc be:exchange-point-and-mark { w } {
    global btp
    $btp(error) "Sorry! No emacs mark for entries yet!" $w
}

proc be:argkey { w a } {
    global btp
    set btp(arg) $a
} 

proc be:numkey { w a } {
    global btp
    if {$btp(arg) == "def"} {
	catch {%W delete sel.first sel.last}
	$w insert insert $a
	tk_entrySeeCaret $w
	set btp(lastkill-entry) -1
	set btp(prevcmd) self-insert
    } else {
	if {$a == "-"} {
	    if {$btp(arg) == "-"} { 
		set btp(arg) "0" 
	    } elseif {$btp(arg) == "0"} {
		set btp(arg) "-"
	    } else {
		set btp(arg) [expr -1*$btp(arg)]
	    }
	} else {
	    append btp(arg) $a
	}
    }
} 

proc be:univ-arg { w } {
    global btp
    if {$btp(arg) == "def"} {
	set btp(arg) 4
    } else {
	if {$btp(arg) == "-"} { 
	    set btp(arg) "-4" 
	} else {
	    set btp(arg) [expr 4*$btp(arg)]
	}
    }
}

proc be:button1-press {w x} {
    global tkPriv

    set tkPriv(selectMode) char
    set tkPriv(mouseMoved) 0
    set tkPriv(entryanchor) [$w index @$x]
    $w icursor @$x
    $w select from @$x
    if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
}

proc be:mouse-select {w x} {
    global tkPriv

    set cur [$w index @$x]
    set anchor $tkPriv(entryanchor)
    if {$cur != $anchor} {
	set tkPriv(mouseMoved) 1
    }
    switch $tkPriv(selectMode) {
	char {
	    if $tkPriv(mouseMoved) {
		$w select to $cur
	    }
	}
	word {
	    if {$cur < $tkPriv(entryanchor)} {
		$w select from [be:word-start $w $cur]
	        $w select to [be:word-end $w [expr $anchor-1]]
	    } else {
	        $w select from [be:word-start $w $anchor]
		$w select to [be:word-end $w $cur]
	    }
	}
	line {
	    $w select from 0
	    $w select to end
	}
    }
    update idletasks
}

proc be:word-start {w ndx} {
  set string [$w get]
  while {$ndx > 0} {
    if {![string length [string trim [string range $string $ndx $ndx]]]} {
      return [expr $ndx+1]
    }
    incr ndx -1
  }
  return 0
}

proc be:word-end {w ndx} {
  set string [$w get]
  while {$ndx < [string length $string]} {
    if {![string length [string trim [string range $string $ndx $ndx]]]} {
      return [expr $ndx-1]
    }
    incr ndx
  }
  return [string length $string]
}

proc bind_motifentry { ew } {
    global bind_xnd

    bind $ew <Control-KeyPress> {
        global btp
	if {"%A" != ""} {eval $btp(beep) }
    }

    bind $ew <Delete> {be:delete-back-char-or-sel %W 1}
    bind $ew <BackSpace> {be:delete-back-char-or-sel %W 1}
    bind $ew <Left> {be:move-char %W -1}
    bind $ew <Right> {be:move-char %W 1}
    bind $ew <Control-Left> {be:move-word %W -1}
    bind $ew <Control-Right> {be:move-word %W 1}
    bind $ew <Home> {be:begin-line %W}
    bind $ew <End> {be:end-line %W}

    bind $ew <Any-KeyPress> {
        global btp
	if {"%A" != ""} {
	    catch {%W delete sel.first sel.last}
	    %W insert insert %A
	    tk_entrySeeCaret %W
	    set btp(lastkill-entry) -1
	    set btp(prevcmd) self-insert
	}
    }

    bind $ew <1> {
      global btp
      be:button1-press %W %x
      %W select clear
      set btp(lastkill-entry) -1
      set btp(prevcmd) mouse-set
    }
    bind $ew <B1-Motion> {
	be:mouse-select %W %x
    }
    bind $ew <Double-1> {
	set tkPriv(selectMode) word
	be:mouse-select %W %x
	catch {%W icursor sel.first}
    }
    bind $ew <Triple-1> {
	set tkPriv(selectMode) line
	be:mouse-select %W %x
	%W icursor 0
    }
    bind $ew <Shift-1> {
	set tkPriv(selectMode) char
	%W select adjust @%x
    }
    bind $ew <Double-Shift-1>	{
	set tkPriv(selectMode) word
	be:mouse-select %W %x
    }
    bind $ew <Triple-Shift-1>	{
	set tkPriv(selectMode) line
	be:mouse-select %W %x
    }
    bind $ew <Control-1> {
	%W icursor @%x
    }

    bind $ew <3> {%W select clear}
    bind $ew <Shift-2> {%W scan mark %x}
    bind $ew <Shift-B2-Motion> {%W scan dragto %x}

    set bind_xnd(b2-time) 0
    bind $ew <2> {
        global bind_xnd
        %W scan mark %x
        set bind_xnd(b2-time) %t
    }
    bind $ew <ButtonRelease-2> {
        global bind_xnd btp
	if {[expr %t-$bind_xnd(b2-time)]<$btp(time-to-scan)} {
	    set btp(lastkill-entry) -1
	    regsub -all "\n" [selection_if_any] { } str
	    %W insert insert $str
 	    set btp(prevcmd) mouse-insert
        }
    }

}

proc bind_emacsentry { ew } {
    global btp

    bind $ew <KeyPress-0> {be:numkey %W %A}
    bind $ew <KeyPress-1> {be:numkey %W %A}
    bind $ew <KeyPress-2> {be:numkey %W %A}
    bind $ew <KeyPress-3> {be:numkey %W %A}
    bind $ew <KeyPress-4> {be:numkey %W %A}
    bind $ew <KeyPress-5> {be:numkey %W %A}
    bind $ew <KeyPress-6> {be:numkey %W %A}
    bind $ew <KeyPress-7> {be:numkey %W %A}
    bind $ew <KeyPress-8> {be:numkey %W %A}
    bind $ew <KeyPress-9> {be:numkey %W %A}

    bind $ew <Control-u> {be:univ-arg %W}
    bind $ew <Control-0> {be:argkey %W %A}
    bind $ew <Control-1> {be:argkey %W %A}
    bind $ew <Control-2> {be:argkey %W %A}
    bind $ew <Control-3> {be:argkey %W %A}
    bind $ew <Control-4> {be:argkey %W %A}
    bind $ew <Control-5> {be:argkey %W %A}
    bind $ew <Control-6> {be:argkey %W %A}
    bind $ew <Control-7> {be:argkey %W %A}
    bind $ew <Control-8> {be:argkey %W %A}
    bind $ew <Control-9> {be:argkey %W %A}
    bind $ew <Control-minus> {be:argkey %W %A}

    bind $ew <Control-a> {be:begin-line %W}
    bind $ew <Control-e> {be:end-line %W}
    bind $ew <Control-b> {be:move-char %W -1}
    bind $ew <Control-f> {be:move-char %W 1}

    bind $ew <Control-l> {
	tk_entrySeeCaret %W
    }

    bind $ew <Control-d> {be:delete-back-char-or-sel %W 0}
    bind $ew <Control-k> {be:delete-line %W}
    bind $ew <Control-w> {be:delete-region-or-sel %W}
    bind $ew <Control-y> {be:yank %W}
    bind $ew <Control-space> {be:set-mark %W}

    bind $ew <Control-h> {be:delete-back-char-or-sel %W 1}

    # make C-x key a state
    bind $ew <Control-x> { }
    bind $ew <Control-x><Any-KeyPress> {
	global btp
	if {"%A" != ""} {eval $btp(beep) }
    }
    bind $ew <Control-x><Control-x> {be:exchange-point-and-mark %W}

    if {$btp(use-esc-prefix)} {
      # make Escape key simulate Alt key
      bind $ew <Escape> { }
      bind $ew <Escape><Any-KeyPress> {
	  global btp
	  if {"%A" != ""} {eval $btp(beep) }
      }

      bind $ew <Escape><KeyPress-0> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-1> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-2> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-3> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-4> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-5> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-6> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-7> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-8> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-9> {be:argkey %W %A}
      bind $ew <Escape><KeyPress-minus> {be:argkey %W %A}

      bind $ew <Escape><b> {be:move-word %W -1}
      bind $ew <Escape><f> {be:move-word %W 1}
      bind $ew <Escape><KeyPress-d> {be:delete-word %W 1}
      bind $ew <Escape><KeyPress-w> {be:copy-region-or-sel %W}
      bind $ew <Escape><KeyPress-y> {be:yank-pop %W}
    }

    # Make Meta key like and Escape prefix
    if {$btp(use-meta)} {
	bind $ew <Meta-KeyPress> {
	    global btp
	    if {"%A" != ""} {eval $btp(beep) }
	}
	bind $ew <Control-Meta-KeyPress> {
	    global btp
	    if {"%A" != ""} {eval $btp(beep) }
	}
        bind $ew <Meta-b> {be:move-word %W -1}
        bind $ew <Meta-f> {be:move-word %W 1}
        bind $ew <Meta-d> {be:delete-word %W 1}
	bind $ew <Meta-w> {be:copy-region-or-sel %W}
	bind $ew <Meta-y> {be:yank-pop %W}

	bind $ew <Meta-0> {be:argkey %W %A}
	bind $ew <Meta-1> {be:argkey %W %A}
	bind $ew <Meta-2> {be:argkey %W %A}
	bind $ew <Meta-3> {be:argkey %W %A}
	bind $ew <Meta-4> {be:argkey %W %A}
	bind $ew <Meta-5> {be:argkey %W %A}
	bind $ew <Meta-6> {be:argkey %W %A}
	bind $ew <Meta-7> {be:argkey %W %A}
	bind $ew <Meta-8> {be:argkey %W %A}
	bind $ew <Meta-9> {be:argkey %W %A}
	bind $ew <Meta-minus> {be:argkey %W %A}
    }
}

proc bind_macentry { ew } {
    global btp

    bind $ew <Control-x> {be:delete-region-or-sel %W}
    bind $ew <Control-c> {be:copy-region-or-sel %W}
    bind $ew <Control-v> {be:yank %W}

    bind $ew <KeyPress-0> {be:numkey %W %A}
    bind $ew <KeyPress-1> {be:numkey %W %A}
    bind $ew <KeyPress-2> {be:numkey %W %A}
    bind $ew <KeyPress-3> {be:numkey %W %A}
    bind $ew <KeyPress-4> {be:numkey %W %A}
    bind $ew <KeyPress-5> {be:numkey %W %A}
    bind $ew <KeyPress-6> {be:numkey %W %A}
    bind $ew <KeyPress-7> {be:numkey %W %A}
    bind $ew <KeyPress-8> {be:numkey %W %A}
    bind $ew <KeyPress-9> {be:numkey %W %A}

    bind $ew <Control-0> {be:argkey %W %A}
    bind $ew <Control-1> {be:argkey %W %A}
    bind $ew <Control-2> {be:argkey %W %A}
    bind $ew <Control-3> {be:argkey %W %A}
    bind $ew <Control-4> {be:argkey %W %A}
    bind $ew <Control-5> {be:argkey %W %A}
    bind $ew <Control-6> {be:argkey %W %A}
    bind $ew <Control-7> {be:argkey %W %A}
    bind $ew <Control-8> {be:argkey %W %A}
    bind $ew <Control-9> {be:argkey %W %A}
    bind $ew <Control-minus> {be:argkey %W %A}

}

#
# Listbox
#

proc bind_listbox { lw } {
  bind $lw <Up> {
    if {![string length [set ndx [%W curselection]]]} {set ndx 0}
    incr ndx -1
    %W select from $ndx
    set ymax [%W nearest [winfo height %W]]
    set ymin [%W nearest 0]
    if {$ndx > $ymax} {
      %W yview [expr $ndx-$ymax+$ymin]
    } elseif {$ndx < $ymin}  {
      %W yview $ndx
    }
  }
  bind $lw <Down> {
    if {![string length [set ndx [%W curselection]]]} {set ndx 0}
    incr ndx 1
    %W select from $ndx
    set ymax [%W nearest [winfo height %W]]
    set ymin [%W nearest 0]
    if {$ndx > $ymax} {
      %W yview [expr $ndx-$ymax+$ymin]
    } elseif {$ndx < $ymin}  {
      %W yview $ndx
    }
  }
}

# Fake TclX procedures if you don't have them

if {[catch "infox version"]} {

  proc lassign { vallist args } {
    set cnt 0
    set len [llength $vallist]
    foreach var $args {
      if {$cnt < $len} {
	set val [lindex $vallist $cnt]
	uplevel "set $var \{$val\}"
      } else {
	uplevel "set $var {}"
      }
      incr cnt
    }
  }
  
  # won't insert an empty string
  proc lvarpop { var {ndx 0} {str {}} } {
    if {[string trim $ndx] == "end" } { set ndx [expr [llength $var]-1]}
    set tmp [uplevel "lindex \$$var $ndx"]
    if {[string length $str]} {
      uplevel "set $var \[lreplace \$$var $ndx $ndx \{$str\} \]"
    } else {
      uplevel "set $var \[lreplace \$$var $ndx $ndx \]"
    }
    return $tmp
  }
  
  proc lvarpush {  var str {ndx 0}  } {
    if {[string trim $ndx] == "end" } { set ndx [expr [llength $var]-1]}
    uplevel "set $var \[linsert \$$var $ndx \{$str\} \]"
    return
  }
  
}

