# $Header: /usr2/people/raines/src/tk/tkmail/bindings.tk,v 1.10 94/01/25 09:32:16 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) 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
# column at which to line wrap
set btp(fillcol) 0
# prefix for line wrapping (NOT REALLY WORKING YET)
set btp(fillprefix) ""

# PRIVATE SETTINGS

set btp(lastkill) 0.0
set btp(killring) ""
set btp(killptr) 0
set btp(killlen) 0
set btp(arg) def

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
    catch {unset btp($w,markring)}
}

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

proc bt:current-col { w } {
    return [lindex [split [$w index insert] .] 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) [lindex [split [$w index insert] .] 1]
    }
    if {$num > -1} {set num "+$num"}
    $w tag remove sel 1.0 end
    set ndx [$w index "insert $num line lineend"]
    set goalndx [lindex [split $ndx .] 0].$btp(goalcol)
    if {$btp(goalcol) < [lindex [split $ndx .] 1]} {
        $w mark set insert $goalndx
    } else {
        $w mark set insert $ndx
    }
    $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 tag remove sel 1.0 end
    $w mark set insert "insert $num char"
    $w yview -pickplace insert
    set btp(prevcmd) "move-char"
}

proc bt:move-word {w {num 1}} {
    global btp
    set btp(lastkill) 0.0
    $w tag remove sel 1.0 end
    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 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 mark set insert insert-1c
	    } 
	    $w mark set insert {insert wordstart}
	}
    }
    $w yview -pickplace insert
    set btp(prevcmd) "move-word"
}

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}
    $w tag remove sel 1.0 end
    $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}
    $w tag remove sel 1.0 end
    $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+[lindex [split [$w index end] .] 0]*$num/10]
    $w mark set insert $ndx.0
    $w tag remove sel 1.0 end
    $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 [lindex [split [$w index end] .] 0]*$num/10]
    $w mark set insert "end - $ndx lines"
    $w tag remove sel 1.0 end
    $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
    }
    $w tag remove sel 1.0 end
    set scr [lindex [lindex [$w configure -yscroll] 4] 0]
    $w mark set insert [lindex [$scr get] 3].0
    $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
    }
    $w tag remove sel 1.0 end
    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
    $w yview insert-1l
    set btp(prevcmd) scroll-prior
}

proc bt:delete-word { w {num 1}} {
    global btp
    $w tag remove sel 1.0 end
    if {[$w compare $btp(lastkill) == insert]} {
	set lastcut [bt:pop-cut]
    } else { set lastcut "" }
    set beg [$w index insert]
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    bt:move-word $w $num
    puts "$num : $beg [$w index insert]"
    if {$beg < [$w index insert]} {
        bt:push-cut "$lastcut[$w get $beg insert]"
        $w delete $beg insert
    } else {
        bt:push-cut "[$w get insert $beg]$lastcut"
        $w delete 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
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    if {[$w compare $btp(lastkill) == insert]} {
	set lastcut [bt:pop-cut]
    } else { set lastcut ""}
    while {[$w get insert] == " "} {
	$w mark set insert insert+1c
    } 
    if {[$w compare insert == "insert lineend"] && $num == 0} { set num 1 }
    set beg [$w index insert]
    if {$num != 0} {
	bt:move-line $w $num
	bt:begin-line $w
	if {$beg < [$w index insert]} {
	    bt:push-cut "$lastcut[$w get $beg insert]"
	    $w delete $beg insert
	} else {
	    bt:push-cut "[$w get insert $beg]$lastcut"
	    $w delete insert $beg
	}
    } else {
      bt:push-cut "$lastcut[$w get insert {insert lineend}]"
      $w delete 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 lastcut [bt:pop-cut]
    } else { set lastcut ""}
    if [catch {set tmp [$w get sel.first sel.last]}] {
        if {$btp(arg) != "def"} {
	    if {$num < 0} {
		bt:push-cut "[$w get "insert $num char" insert]$lastcut"
	        $w delete "insert $num char" insert
	    } else {
		bt:push-cut "$lastcut[$w get insert "insert $num char"]"
	        $w delete insert "insert $num char"
	    }
	    set btp(lastkill) [$w index insert]
        } else {
	    if {$num < 0} {
	        $w delete "insert $num char" insert
	    } else {
	        $w delete insert "insert $num char"
	    }
	    set btp(lastkill) 0.0
        }
    } else {
	$w delete sel.first sel.last
	bt:push-cut $tmp
        set btp(lastkill) 0.0
    }
    set btp(arg) def
    $w yview -pickplace insert
    set btp(prevcmd) delete-back-char-or-sel
}

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

    if {[catch {set tmp [$w get sel.first sel.last]}]} {
	if {[catch "$w index emacs"]} {
	    $btp(error) "No emacs mark has been set yet!"
	}
        if {[$w compare $btp(lastkill) == insert]} {
	    set lastcut [bt:pop-cut]
        } else { set lastcut ""}
	if {[$w compare emacs < insert]} {
	    bt:push-cut "$lastcut[$w get emacs insert]"
	    $w delete emacs insert
	} else {
	    bt:push-cut "[$w get insert emacs]$lastcut"
	    $w delete insert emacs
	}
        set btp(lastkill) [$w index insert]
    } else {
	$w delete sel.first sel.last
	bt:push-cut $tmp
        set btp(lastkill) 0.0
    }
    set btp(arg) def
    set btp(prevcmd) delete-region-or-sel
}

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

    if {[catch {set tmp [$w get sel.first sel.last]}]} {
	if {[catch "$w index emacs"]} {
	    $btp(error) "No emacs mark has been set yet!"
	}
        if {[$w compare $btp(lastkill) == insert]} {
	    set lastcut [bt:pop-cut]
        } else { set lastcut ""}
	if {[$w compare emacs < insert]} {
	    bt:push-cut "$lastcut[$w get emacs insert]"
	} else {
	    bt:push-cut "[$w get insert emacs]$lastcut"
	}
	bt:exchange-point-and-mark $w
	after 200 bt:exchange-point-and-mark $w
    } else {
	bt:push-cut $tmp
    }
    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:push-cut { txt } {
    global btp

    set btp(killlen) [llength [lappend btp(killring) $txt]]
    if { $btp(killlen) > $btp(maxkill)} {
	set btp(killring) [lreplace $btp(killring) 0 0]
	incr btp(killlen) -1
    }
    set btp(killptr) 0
}

proc bt:pop-cut { } {
    global btp

    if {$btp(killlen) == 0} {return ""}
    set txt [bt:get-cut 1]
    set ndx [expr $btp(killlen)-1]
    set btp(killring) [lreplace $btp(killring) $ndx $ndx ]
    incr btp(killlen) -1
    set btp(killptr) 0
    return $txt
}

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

    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:yank { w {num 1}} {
    global btp
    $w tag remove sel 1.0 end
    if {$btp(arg) != "def"} {
	set num $btp(arg)
	set btp(arg) def
    }
    set btp(lastkill) 0.0
    set tmp [$w index insert]
    $w insert insert [bt:get-cut $num]
    $w mark set emacs $tmp
    $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
    $w tag remove sel 1.0 end
    $w delete emacs insert
    set tmp [$w index insert]
    $w insert insert [bt:get-cut [expr $num+1]]
    $w mark set emacs $tmp
    $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:set-mark { w {num def}} {
    global btp
    $w tag remove sel 1.0 end
    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 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
    }
    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!"
    }
    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
    }
    catch {$w delete sel.first sel.last}
    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:argkey { w a } {
    global btp
    set btp(arg) $a
} 

proc bt:numkey { w a } {
    global btp
    if {$btp(arg) == "def"} {
	catch {%W delete sel.first sel.last}
	$w insert insert $a
	if {$btp(fillcol) && [bt:current-col $w] >= $btp(fillcol)} {
	    bt:wrap-word $w
	}
	$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:wrap-word { w } {
    global btp

    bt:move-word $w -1
    $w insert insert \n
    bt:end-line $w
}

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
}

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 <Next> {bt:scroll-next %W}
    bind $tw <Prior> {bt:scroll-prior %W}

    bind $tw <Any-KeyPress> {
	global btp
	set num 1
	if {"%A" != ""} {
	    if {$btp(arg) != "def"} {
		set num $btp(arg)
		set btp(arg) def
	    }
	    catch {%W delete sel.first sel.last}
	    for {set i 0} { $i < $num} {incr i} {%W insert insert %A}
	    if {$btp(fillcol) && [bt:current-col %W] >= $btp(fillcol)} {
		if {"%A" == " "} {
		    %W insert insert \n
		} elseif {"%A" == "\t"} {
		    %W insert insert \n\t
		} else {
		    bt:wrap-word %W
		}
	    }
	    %W yview -pickplace insert
	    set btp(lastkill) 0.0
	    set btp(prevcmd) self-insert
	}
    }

    bind $tw <KeyPress-Return> {
	global btp
        catch {%W delete sel.first sel.last}
	set num 1
	if {$btp(arg) != "def"} {
	    set num $btp(arg)
	    set btp(arg) def
	}
        for {set i 0} { $i < $num} {incr i} {%W insert insert "\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> "[bind Text <1>]; \
                  global btp; set btp(lastkill) 0.0; \
		  set btp(prevcmd) mouse-set"
    bind $tw <3> {%W tag remove sel 1.0 end}
    bind $tw <B1-Motion> {bind_textB1motion %W @%x,%y}

    set bind_xnd(b2-time) 0
    set bind_xnd(b2-y) 0
    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
	if {[expr %t-$bind_xnd(b2-time)]<1000} {
	    %W insert insert [selection_if_any]
 	    global btp
	    set btp(lastkill) 0.0
	    set btp(prevcmd) mouse-insert
        }
    }

    # only one mouse, so no need have separate vars for each widget
    set bind_xnd(txnd) 0
    set bind_xnd(xdelay) 100
    proc bind_textB1motion  { w loc } {
	global bind_xnd

	set ypos [lindex [split $loc ","] 1]
	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)} {
		tk_textSelectTo $w $loc
	}

    }

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

    proc bind_textExtend { w } {
	 global bind_xnd

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

}

proc bind_emacstext { tw } {
    global btp

    # 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 <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 <Escape><f> {bt:move-word %W 1}
    bind $tw <Escape><b> {bt:move-word %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 <Escape><d> {bt:delete-word %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 <Escape><w> {bt:copy-region-or-sel %W}
    bind $tw <Control-y> {bt:yank %W}
    bind $tw <Escape><y> {bt:yank-pop %W}
    bind $tw <Control-space> {bt:set-mark %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 <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}

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

    # 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-w> {bt:copy-region-or-sel %W}
	bind $tw <Meta-y> {bt:yank-pop %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}
    }
}

##############
# 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 lastcut [bt:pop-cut]
    } else { set lastcut "" }
    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 "$lastcut[string range [$w get] $beg $endx]"
	$w delete $beg $endx
    } else {
	incr beg -1
	bt:push-cut "[string range [$w get] $endx $beg]$lastcut"
	$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 lastcut [bt:pop-cut]
    } else { set lastcut "" }
    $w select clear
    bt:push-cut "$lastcut[string range [$w get] [$w index insert] end]"
    $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!"
    } else {
	bt:push-cut [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!"
    } else {
	bt:push-cut [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 $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 [expr $num+1]]
    tk_entrySeeCaret $w
}

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


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

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 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> "[bind Entry <1>]; \
                  global btp; set btp(lastkill-entry) -1; \
		  set btp(prevcmd) mouse-set"
    bind $ew <Double-Button-1> {%W select from 0; %W select to end}
    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)]<1000} {
	    set btp(lastkill-entry) -1
	    %W insert insert [selection_if_any]
 	    set btp(prevcmd) mouse-insert
        }
    }

}

proc bind_emacsentry { ew } {
    global btp

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

    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 <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 <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 <Escape><b> {be:move-word %W -1}
    bind $ew <Escape><f> {be:move-word %W 1}

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

    bind $ew <Control-d> {be:delete-back-char-or-sel %W 0}
    bind $ew <Escape><KeyPress-d> {be:delete-word %W 1}
    bind $ew <Control-k> {be:delete-line %W}
    bind $ew <Control-w> {be:delete-region-or-sel %W}
    bind $ew <Escape><KeyPress-w> {be:copy-region-or-sel %W}
    bind $ew <Control-y> {be:yank %W}
    bind $ew <Escape><KeyPress-y> {be:yank-pop %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}

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

