# ctcomp.tcl --
#
#       "Chat text completion -- Tkabber plugin.
#
# Author: Konstantin Khomoutov <flatworm@users.sourceforge.net>
#
# See "lisence.terms" for details about distribution.
# Consult README for the information and usage guidelines.

option add *Chat.textCompletionForeground    black   widgetDefault
option add *Chat.textCompletionBackground    pink    widgetDefault

package require msgcat

namespace eval ctcomp {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]
    if {![::plugins::is_registered ctcomp]} {
        ::plugins::register ctcomp \
            -namespace [namespace current] \
            -source [info script] \
            -description [::msgcat::mc "Whether the Chat text completion\
                                        plugin is loaded."] \
            -loadcommand [namespace code load] \
            -unloadcommand [namespace code unload]
        return
    }
}

proc ctcomp::load {} {
    variable options
    set options(pattern) {\m%s\w+\M}

    bind_events
    bind_tags

    hook::add open_chat_post_hook  [namespace current]::prepare
    hook::add close_chat_post_hook [namespace current]::cleanup

    foreach chatid [chat::opened] {
        prepare $chatid
    }
}

proc ctcomp::unload {} {
    foreach chatid [chat::opened] {
        unprepare $chatid
    }

    hook::remove open_chat_post_hook  [namespace current]::prepare
    hook::remove close_chat_post_hook [namespace current]::cleanup

    unbind_tags
    unbind_events

    variable options
    unset options
}

proc ctcomp::bind_events {} {
    event add <<ChatTextCompNext>>    <Control-n>
    event add <<ChatTextCompNext>>    <Alt-slash>
    event add <<ChatTextCompNext>>    <Meta-slash>
    event add <<ChatTextCompPrev>>    <Control-p>
    event add <<ChatTextCompAccept>>  <Return>
    event add <<ChatTextCompCancel>>  <Escape>
    event add <<ChatTextCompMenu>>    <Alt-Control-slash>
    event add <<ChatTextCompMenu>>    <Meta-Control-slash>
}

proc ctcomp::unbind_events {} {
    event delete <<ChatTextCompNext>>    <Control-n>
    event delete <<ChatTextCompNext>>    <Alt-slash>
    event delete <<ChatTextCompNext>>    <Meta-slash>
    event delete <<ChatTextCompPrev>>    <Control-p>
    event delete <<ChatTextCompAccept>>  <Return>
    event delete <<ChatTextCompCancel>>  <Escape>
    event delete <<ChatTextCompMenu>>    <Alt-Control-slash>
    event delete <<ChatTextCompMenu>>    <Meta-Control-slash>
}

proc ctcomp::bind_tags {} {
    bind ChatTextCompInactive <<ChatTextCompNext>> [namespace code {
        if {[matches in %W]} {
            activate %W
            match first next in %W
        }
        break
    }]
    bind ChatTextCompInactive <<ChatTextCompPrev>> [namespace code {
        if {[matches in %W]} {
            activate %W
            match first prev in %W
        }
        break
    }]
    bind ChatTextCompInactive <<ChatTextCompMenu>> [namespace code {
        if {[matches in %W]} {
            show_matches in %W
            reset_state %W
        }
        break
    }]

    bind ChatTextCompActive <<ChatTextCompNext>>   [namespace code {
        match next next in %W
        break
    }]
    bind ChatTextCompActive <<ChatTextCompPrev>>   [namespace code {
        match next prev in %W
        break
    }]
    bind ChatTextCompActive <<ChatTextCompAccept>> [namespace code {
        accept %W
        deactivate %W
        break
    }]
    bind ChatTextCompActive <<ChatTextCompCancel>> [namespace code {
        cancel %W
        deactivate %W
        break
    }]
    bind ChatTextCompActive <Key> [namespace code {
        accept %W
        deactivate %W
    }]
}

proc ctcomp::unbind_tags {} {
    bind ChatTextCompInactive <<ChatTextCompNext>> {}
    bind ChatTextCompInactive <<ChatTextCompPrev>> {}
    bind ChatTextCompInactive <<ChatTextCompMenu>> {}
    bind ChatTextCompActive <<ChatTextCompNext>>   {}
    bind ChatTextCompActive <<ChatTextCompPrev>>   {}
    bind ChatTextCompActive <<ChatTextCompAccept>> {}
    bind ChatTextCompActive <<ChatTextCompCancel>> {}
    bind ChatTextCompActive <Key> {}
}

proc ctcomp::initialize iw {
    set btags [bindtags $iw]
    set ix [lsearch -exact $btags $iw]
    bindtags $iw [linsert $btags $ix ChatTextCompInactive]

    reset_state $iw
}

proc ctcomp::deinitialize iw {
    set btags [bindtags $iw]
    delete_from_list btags ChatTextCompInactive
    if {[delete_from_list btags ChatTextCompActive]} {
        cancel $iw
    }
    bindtags $iw $btags
}

proc ctcomp::delete_from_list {listVar elem} {
    upvar 1 $listVar L
    set ix [lsearch -exact $L $elem]
    if {$ix >= 0} {
        set L [lreplace $L $ix $ix]
        return 1
    } else {
        return 0
    }
}

proc ctcomp::activate iw {
    variable $iw
    upvar 0 $iw state

    set btags [bindtags $iw]
    set ix [lsearch -exact $btags ChatTextCompInactive]
    bindtags $iw [lreplace $btags $ix $ix ChatTextCompActive]

    hook::run chat_text_completion_start_hook $state(chatid) $state(what)
}

proc ctcomp::deactivate iw {
    variable $iw
    upvar 0 $iw state

    set btags [bindtags $iw]
    set ix [lsearch -exact $btags ChatTextCompActive]
    bindtags $iw [lreplace $btags $ix $ix ChatTextCompInactive]

    hook::run chat_text_completion_end_hook $state(chatid)

    reset_state $iw
}

proc ctcomp::prepare {chatid args} {
    set iw [chat::input_win $chatid]

    variable $iw
    upvar 0 $iw state
    set state(chatid) $chatid

    initialize $iw
}

proc ctcomp::unprepare {chatid} {
    set iw [chat::input_win $chatid]
    deinitialize $iw
    delete_state $iw
}

# NOTE This proc is called *after* the chat window is destroyed,
# by the means of the close_chat_post_hook hook.
# Getting the input window's name can be considered a hack
# as there's no implied guarantee that this name can be obtained
# and/or will have sensible meaning after the chat is closed.
proc ctcomp::cleanup {chatid} {
    set iw [chat::input_win $chatid]
    delete_state $iw
}

proc ctcomp::delete_state {iw} {
    variable $iw
    unset $iw
}

proc ctcomp::reset_state iw {
    variable $iw
    upvar 0 $iw state

    set state(matches) [list]
    set state(last)    ""
    set state(what)    ""
}

proc ctcomp::accept iw {
    $iw tag remove ctcomp/submatch comp_start comp_end
    $iw mark unset comp_start
    $iw mark unset comp_end
}

proc ctcomp::cancel iw {
    $iw delete comp_start comp_end
    $iw mark unset comp_start
    $iw mark unset comp_end
}

proc ctcomp::pattern what {
    variable options

    format $options(pattern) [string map {
        \\  \\\\
        [   \\[
        ]   \\]
        \{  \\\{
        \}  \\\}
        (   \\(
        )   \\)
        $   \\$
        .   \\.
        *   \\*
        ?   \\?
    } $what]
}

proc ctcomp::matches {"in" iw} {
    variable $iw
    upvar 0 $iw state
    upvar 0 state(what)    what
    upvar 0 state(matches) matches

    set what [word from $iw]
    if {[string length $what] == 0} { return false }

    set matches [get_matches for $what in $iw]
    if {[llength $matches] == 0} {
        show info $iw "No match for $what"
        return false
    }

    return true
}

proc ctcomp::startOfPreviousWord {str start} {
    if {[string equal $start end]} {
        set start [string length $str]
    }
    if {[regexp -indices {\m(\w+)\W*$} \
            [string range $str 0 [expr {$start - 1}]] -> word]} {
        return [lindex $word 0]
    }
    return -1
}

proc ctcomp::word {"from" t} {
    set from [tk::TextPrevPos $t insert \
        [namespace current]::startOfPreviousWord]
    $t get $from insert
}

proc ctcomp::get_matches {"for" what "in" iw} {
    variable $iw
    upvar 0 $iw state
    upvar 0 state(chatid) chatid

    set completions [concat \
        [get_text_matches for $what in [chat::chat_win $chatid]] \
        [get_text_matches for $what in $iw]]

    hook::run chat_text_completion_matches_hook \
        $chatid $what #[info level] completions

    lsort -dictionary -unique $completions
}

proc ctcomp::get_text_matches {"for" what "in" t} {
    set pos 1.0
    set matches [list]

    while 1 {
        set at [$t search -count len -regexp [pattern $what] $pos end]
        if {$at == {}} break

        lappend matches [$t get $at "$at + $len chars"]

        set pos [$t index "$at + 1 char"]
    }

    set matches
}

proc ctcomp::last L {
    expr {[llength $L] - 1}
}

proc ctcomp::getopt {iw opt} {
    variable $iw
    upvar 0 $iw state

    option get [chat::winid $state(chatid)] $opt Chat
}

proc ctcomp::tail {what match} {
    string range $match [string length $what] end
}

proc ctcomp::match {seq dir "in" iw} {
    variable $iw
    upvar 0 $iw state
    upvar 0 state(what)    what
    upvar 0 state(matches) matches
    upvar 0 state(last)    last

    switch -- $seq {
        first {
            switch -- $dir {
                next { set last 0 }
                prev { set last [last $matches] }
            }
            $iw mark set comp_start insert
            $iw mark gravity comp_start left
        }
        next {
            advance to $dir in $iw
            $iw delete comp_start comp_end
        }
    }

    set submatch [tail $what [lindex $matches $last]]

    $iw tag configure ctcomp/submatch \
        -foreground [getopt $iw textCompletionForeground] \
        -background [getopt $iw textCompletionBackground]

    $iw insert comp_start $submatch ctcomp/submatch
    $iw mark set comp_end insert
    $iw mark gravity comp_end right
}

proc ctcomp::advance {"to" where "in" iw} {
    variable $iw
    upvar 0 $iw state
    upvar 0 state(last)    last
    upvar 0 state(matches) matches

    set end [last $matches]

    switch -- $where {
        next {
            incr last
            if {$last > $end} {
                set last 0
                wraparound in $iw
            }
        }
        prev {
            incr last -1
            if {$last < 0} {
                set last $end
                wraparound in $iw
            }
        }
    }
}

proc ctcomp::wraparound {"in" iw} {
    show info $iw "Wrapped around"
}

proc ctcomp::show_matches {"in" iw} {
    set m $iw.matches
    if {![winfo exists $m]} {
        menu $iw.matches -tearoff no -postcommand [list \
            [namespace current]::repopulate_matches_menu $iw $m]
    }

    lassign [lrange [$iw bbox insert] 0 1] x y
    set x [expr {[winfo rootx $iw] + $x}]
    set y [expr {[winfo rooty $iw] + $y}]
    tk_popup $m $x $y 0
}

proc ctcomp::repopulate_matches_menu {iw m} {
    variable $iw
    upvar 0 $iw state
    upvar 0 state(what) what

    $m delete 0 end

    set i 0
    foreach match $state(matches) {
        if {[incr i] > 20} break
        $m add command -label $match -command [list \
            [namespace current]::menu_insert_match $iw [tail $what $match]]
    }

    hook::run chat_text_completion_menu_hook $state(chatid) $state(what) $m
}


proc ctcomp::menu_insert_match {iw tail} {
    variable $iw

    $iw insert insert $tail
}

# $type should be either "info" or "error"
proc ctcomp::show {type iw msg} {
    variable $iw
    upvar 0 $iw state
    upvar 0 state(chatid) chatid

    set jid [chat::get_jid $chatid]
    set cw [chat::chat_win $chatid]

    chat::add_message $chatid $jid $type $msg {}
}

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