# unixkeys.tcl --
#
#       "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.
#
# Author: Konstantin Khomoutov <flatworm@users.sourceforge.net>
#
# See license.terms for details on usage and distribution.
# See INSTALL for installation procedure.
# See README for usage guidelines.

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 TEntry  $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:et
