# $Id: unixkeys.tcl 1963 2010-11-17 00:39:38Z kostix $
# "Unixkeys" -- plugin for Tkabber.
# Provides keybindings in Tk Text widgets which are familiar
# to Unix users: they resemble "canonical" bindings found in
# readline and Emacs.
# Written by Konstantin Khomoutov <flatworm@users.sourceforge.net>
# See INSTALL for installation procedure.
# See README for usage guidelines.
# See license.terms for details on usage and distribution.

package require msgcat

namespace eval unixkeys {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered unixkeys]} {
        ::plugins::register unixkeys \
            -namespace [namespace current] \
            -source [info script] \
            -description [::msgcat::mc \
		"Whether the Unixkeys plugin is loaded."]\n[::msgcat::mc \
		"This plugin makes the widgets providing textual input\
		    support certain combinations of keystrokes\
		    familiar to the users of Readline and Emacs."] \
            -loadcommand [namespace code load] \
            -unloadcommand [namespace code unload]
        return
    }
}

proc unixkeys::load {} {
    foreach mod {Alt Meta} {
	Bind Text <$mod-Key-a> [bind Text <Control-Key-Home>]
	Bind Text <$mod-Key-e> [bind Text <Control-Key-End>]
	BindEntry <$mod-Key-a> [bind Entry <Key-Home>]
	BindEntry <$mod-Key-e> [bind Entry <Key-End>]
    }

    foreach mod {Alt Meta} {
	Bind Text <$mod-Key-b> [bind Text <Control-Key-Left>]
	Bind Text <$mod-Key-f> [bind Text <Control-Key-Right>]
    }
    BindEntry <Alt-Key-b> [bind Entry <Meta-Key-b>]
    BindEntry <Alt-Key-f> [bind Entry <Meta-Key-f>]

    Bind Text  <Control-Key-u> { %W delete {insert linestart} insert}
    BindEntry <Control-Key-u>  { %W delete 0 insert }

    foreach {mod key} {Alt BackSpace Control w} {
	Bind Text  <$mod-Key-$key> { %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert }
	BindEntry <$mod-Key-$key>  { %W delete [tk::EntryPreviousWord %W insert] insert }
    }

    foreach key {d Delete} {
	foreach mod {Alt Meta} {
	    Bind Text  <$mod-Key-$key> { %W delete insert [::tk::TextNextPos %W insert tcl_endOfWord] }
	    BindEntry <$mod-Key-$key>  { %W delete insert [::tk::EntryNextWord %W insert] }
	}
    }

    if {[string equal $::tcl_platform(os) windows]} {
	AddEvent <<Undo>> <Control-Key-underscore>
    }
    AddEvent <<Undo>> <Control-Key-x><Control-Key-u>

    Bind Text <Control-slash>     { %W tag add sel 1.0 end }
    Bind Text <Control-backslash> { %W tag remove sel 1.0 end }
    Bind Text <Control-Key-x><h>  { %W tag add sel 1.0 end }
    BindEntry <Control-Key-x><h>  [bind Entry <Control-slash>]
}

proc unixkeys::Bind {target event script} {
    set existing [bind $target $event]
    bind $target $event $script

    variable bindtable
    lappend bindtable $target $event $script $existing
}

proc unixkeys::BindEntry {event script} {
    Bind Entry   $event $script
    Bind BwEntry $event $script
}

proc unixkeys::AddEvent {name event} {
    event add $name $event

    variable evtable
    lappend evtable $name $event
}

proc unixkeys::unload {} {
    variable bindtable
    foreach {target event installed original} $bindtable {
	set existing [bind $target $event]
	if {[string equal $existing $installed]} {
	    bind $target $event $original
	}
    }
    unset bindtable

    variable evtable
    foreach {name event} $evtable {
	event delete $name $event
    }
    unset evtable
}

# vim:ts=8:sw=4:sts=4:noet
