# $Header: /a/juno/u1/ra/raines/src/tk/tkmail/bindings.tk,v 1.7 1993/12/10 07:50:12 raines Exp $
# Gives more motif like bindings to Text and Entry Widgets
global bind_textscroll bind_xnd bind_emacs

proc bind_textscrollset { sw tw args } {
    global bind_textscroll
    eval "$sw set $args"
    set bind_textscroll($tw) $args
}

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_motiftext { tw } {
    global bind_xnd

    # Some better bindings for text and entry
    bind $tw <Up> {
      %W tag remove sel 1.0 end
      %W mark set insert {insert - 1 line}
      %W yview -pickplace insert
    }
    bind $tw <Down> {
      %W tag remove sel 1.0 end
      %W mark set insert {insert + 1 line}
      %W yview -pickplace insert
    }
    bind $tw <Left> {
      %W tag remove sel 1.0 end
      %W mark set insert {insert - 1 char}
      %W yview -pickplace insert
    }
    bind $tw <Right> {
      %W tag remove sel 1.0 end
      %W mark set insert {insert + 1 char}
      %W yview -pickplace insert
    }
    bind $tw <Home> {%W mark set insert {insert linestart}
	 %W tag remove sel 1.0 end
	 %W yview -pickplace insert}
    bind $tw <End> {%W mark set insert {insert lineend}
	 %W tag remove sel 1.0 end
	 %W yview -pickplace insert}
    bind $tw <Control-Home> {%W mark set insert 1.0
	 %W tag remove sel 1.0 end
	 %W yview -pickplace insert}
    bind $tw <Control-End> {%W mark set insert end
	 %W tag remove sel 1.0 end
	 %W yview -pickplace insert}

    bind $tw <Next> {
      global bind_textscroll
      %W tag remove sel 1.0 end
      %W mark set insert [lindex $bind_textscroll(%W) 3].0
      %W yview insert
    }
    bind $tw <Prior> {
      global bind_textscroll
      %W tag remove sel 1.0 end
      %W mark set insert [expr \
	    [lindex $bind_textscroll(%W) 2]-[lindex $bind_textscroll(%W) 1]].0
      %W yview insert
    }

    bind $tw <Any-KeyPress> {
	 if {"%A" != ""} {
	     catch {%W delete sel.first sel.last}
	     %W insert insert %A
	    %W yview -pickplace insert
	}
    }

    bind $tw <KeyPress-Delete> {
       if [catch {%W delete sel.first sel.last}] {
	   %W delete [%W index insert-1c]
       }
    }
    bind $tw <KeyPress-BackSpace> {
       if [catch {%W delete sel.first sel.last}] {
	   %W delete [%W index insert-1c]
       }
    }
    bind $tw <KeyPress-Return> {
       catch {%W delete sel.first sel.last}
       %W insert insert "\n"
       %W yview -pickplace insert
    }

    bind $tw <1> "[bind Text <1>]; %W tag remove sel 1.0 end"
    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]
        }
    }

    # 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; set bind_xnd(txnd) 0 }

    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_motifentry { ew } {
    global bind_xnd

    bind $ew <Delete> {
	    if {[catch {%W delete sel.first sel.last}] != 0} {
		    tk_entryBackspace %W
		    tk_entrySeeCaret %W
	    }
    }
    bind $ew <BackSpace> {
	    if {[catch {%W delete sel.first sel.last}] != 0} {
		    tk_entryBackspace %W
		    tk_entrySeeCaret %W
	    }
    }
    bind $ew <Left> {
	    %W select clear
	    %W icursor [expr {[%W index insert] - 1}]
	    tk_entrySeeCaret %W
    }
    bind $ew <Right> {
	    %W select clear
	    %W icursor [expr {[%W index insert] + 1}]
	    tk_entrySeeCaret %W
    }
    bind $ew <Home> {
	    %W select clear
	    %W icursor 0
	    tk_entrySeeCaret %W
    }
    bind $ew <End> {
	    %W select clear
	    %W icursor end
	    tk_entrySeeCaret %W
    }
    bind $ew <Any-KeyPress> {
	if {"%A" != ""} {
	    catch {%W delete sel.first sel.last}
	    %W insert insert %A
	    tk_entrySeeCaret %W
	}
    }

    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
	if {[expr %t-$bind_xnd(b2-time)]<1000} {
	    %W insert insert [selection_if_any]
        }
    }

}

proc bind_emacstext { tw } {
    global bind_emacs

    bind $tw <Control-a> {
        %W tag remove sel 1.0 end
        %W mark set insert {insert linestart}
	%W yview -pickplace insert
    }
    bind $tw <Control-e> {
        %W tag remove sel 1.0 end
	%W mark set insert {insert lineend}
	%W yview -pickplace insert
    }
    bind $tw <Control-f> {
        %W tag remove sel 1.0 end
        %W mark set insert insert+1c
	%W yview -pickplace insert
    }
    bind $tw <Control-b> {
        %W tag remove sel 1.0 end
	%W mark set insert insert-1c
	%W yview -pickplace insert
    }
    bind $tw <Meta-f> {
        %W tag remove sel 1.0 end
        %W mark set insert insert+1c
        %W mark set insert {insert wordend}
	%W yview -pickplace insert
    }
    bind $tw <Meta-b> {
        %W tag remove sel 1.0 end
	%W mark set insert insert-1c
        %W mark set insert {insert wordstart}
	%W yview -pickplace insert
    }
    bind $tw <Control-n> {
        %W tag remove sel 1.0 end
	%W mark set insert insert+1l
	%W yview -pickplace insert
    }
    bind $tw <Control-p> {
        %W tag remove sel 1.0 end
	%W mark set insert insert-1l
	%W yview -pickplace insert
    }
    bind $tw <Control-l> {
	%W yview -pickplace insert
    }
    bind $tw <Control-o> {
	catch {%W delete sel.first sel.last}
        %W insert insert \n
	%W mark set insert insert-1c
	%W yview -pickplace insert
    }
    bind $tw <Control-d> {
        %W tag remove sel 1.0 end
	%W delete insert insert+1c
        %W yview -pickplace insert
    }
    bind $tw <Meta-d> {
        %W tag remove sel 1.0 end
	%W delete insert {insert wordend}
        %W yview -pickplace insert
    }


    bind $tw <Control-h> {
       if [catch {%W delete sel.first sel.last}] {
	   %W delete [%W index insert-1c]
       }
    }

    set bind_emacs(lastkill) 0.0
    bind $tw <Control-k> {
	global bind_emacs
        %W tag remove sel 1.0 end
	if {[%W compare $bind_emacs(lastkill) != insert]} {
	    set bind_emacs(cutbuffer) ""
        } 
	if {[%W compare insert == "insert lineend"]} {
	  set bind_emacs(cutbuffer) "$bind_emacs(cutbuffer)\n"
	  %W delete insert "insert lineend +1c"
	  %W yview -pickplace insert
	} else {
	  set bind_emacs(cutbuffer) \
	      "$bind_emacs(cutbuffer)[%W get insert {insert lineend}]"
	  %W delete insert {insert lineend};
          %W yview -pickplace insert
	}
	set bind_emacs(lastkill) [%W index insert]
    }
    bind $tw <Control-w> {
	global bind_emacs
        %W tag remove sel 1.0 end
        set bind_emacs(lastkill) 0.0
	if {[%W compare emacs < insert]} {
	    set bind_emacs(cutbuffer) [%W get emacs insert]
	    %W delete emacs insert
        } else {
            set bind_emacs(cutbuffer) [%W get insert emacs]
            %W delete insert emacs
        }
    }
    bind $tw <Meta-w> {
	global bind_emacs
        %W tag remove sel 1.0 end
        set bind_emacs(lastkill) 0.0
	if {[%W compare emacs < insert]} {
	    set bind_emacs(cutbuffer) [%W get emacs insert]
        } else {
            set bind_emacs(cutbuffer) [%W get insert emacs]
        }
    }
    bind $tw <Control-y> {
	global bind_emacs
        %W tag remove sel 1.0 end
        set bind_emacs(lastkill) 0.0
	%W insert insert $bind_emacs(cutbuffer)
	%W yview -pickplace insert
    }
    bind $tw <Control-space> {
	global bind_emacs
        %W tag remove sel 1.0 end
        set bind_emacs(lastkill) 0.0
        %W mark set emacs insert
    }

}

proc bind_emacsentry { ew } {
    global bind_emacs

    bind $ew <Control-a> {
	%W select clear
	%W icursor 0
	tk_entrySeeCaret %W
    }
    bind $ew <Control-e> {
	%W select clear
	%W icursor end
	tk_entrySeeCaret %W
    }
    bind $ew <Control-b> {
	%W select clear
	%W icursor [expr {[%W index insert] - 1}]
	tk_entrySeeCaret %W
    }
    bind $ew <Control-f> {
	%W select clear
	%W icursor [expr {[%W index insert] + 1}]
	tk_entrySeeCaret %W
    }
    bind $ew <Control-l> {
	tk_entrySeeCaret %W
    }
    bind $ew <Control-d> {
	%W select clear
	%W delete [%W index insert]
	tk_entrySeeCaret %W
    }
    bind $ew <Control-k> {
        global bind_emacs
	%W select clear
	set bind_emacs(cutbuffer) [%W index insert] end
	%W delete [%W index insert] end
	tk_entrySeeCaret %W
    }
    bind $ew <Control-w> {
	global bind_emacs
	if {![catch "%W index sel.first"]} {
	    set bind_emacs(cutbuffer) [selection_if_any]
	    %W delete sel.first sel.last
	    tk_entrySeeCaret %W
        }
    }
    bind $ew <Control-y> {
	global bind_emacs
	%W insert insert $bind_emacs(cutbuffer)
	tk_entrySeeCaret %W
    }

   bind $ew <Control-KeyPress-h> {
      if [catch {%W delete sel.first sel.last}] \
         {%W delete [expr [%W index insert]-1]}
   }

}

