# tclchat.tcl --
#
#       This file is a part of implementation of Tkabber's interface to
#       the Tcler's chat. Inject the history from the tclers chat logs
#       into the current chat window. This hook only activates if you open
#       a groupchat to a site that we know is linked to the tclers chat.
#       ie: tach.tclers.tk or the irc channel.
#
# Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
# Copyright (C) 2007-2009 Sergei Golovan <sgolovan@nes.ru>

package require msgcat

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

    if {![::plugins::is_registered tclchat]} {
        ::plugins::register tclchat \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description [::msgcat::mc "Whether the Tclchat\
                                                        plugin is loaded."] \
                            -loadcommand [namespace code load] \
                            -unloadcommand [namespace code unload]
        return
    }

    custom::defgroup Plugins [::msgcat::mc "Plugins options."] \
        -group Tkabber

    custom::defgroup Tclchat [::msgcat::mc "Tclchat plugin options."] \
        -group Plugins

    custom::defvar options(use_tkchat_colors) 1 \
        [::msgcat::mc "Use TkChat embedded colors."] \
        -group Chat -group Tclchat -type boolean
}

# Load in the additional files that are part of the tclchat plugin.
#
source [file join [file dirname [info script]] tclchat_messages.tcl]
source [file join [file dirname [info script]] tclchat_commands.tcl]

package require http 2

proc tclchat::load {} {
    load_commands
    load_messages

    hook::add finload_hook [namespace current]::on_init 30
    hook::add open_chat_post_hook [namespace current]::on_open_chat
    hook::add chat_send_message_xlist_hook [namespace current]::add_color

    on_init
}

proc tclchat::unload {} {
    catch {
        set menu [.mainframe getmenu plugins]
        set idx [$menu index [msgcat::mc "Tkchat colors"]]
        $menu delete $idx
    }

    unload_commands
    unload_messages

    hook::remove finload_hook [namespace current]::on_init 30
    hook::remove open_chat_post_hook [namespace current]::on_open_chat
    hook::remove chat_send_message_xlist_hook [namespace current]::add_color
}

proc tclchat::on_init {} {
    global tcl_platform
    global loginconf
    variable Options
    variable urlid 0

    catch {
        set menu [.mainframe getmenu plugins]
        $menu add checkbutton -label [msgcat::mc "Tkchat colors"] \
              -underline 0 \
              -variable [namespace current]::options(use_tkchat_colors)
    }

    array set Options {
        HistoryLines  0
        url           "http://tclers.tk/conferences/tcl"
        sel           "/?pattern=*.tcl"
        RE            {<A HREF="([0-9\-%d]+\.tcl)">.*\s([0-9]+) bytes}
    }
}

proc tclchat::on_open_chat {chatid type} {
    variable Options
    if {[string equal $type "groupchat"]} {
        switch -glob -- [set mucjid [chat::get_jid $chatid]] {
            *@tach.tclers.tk {
                set muc [lindex [split $mucjid @] 0]
                set Options(url) "http://tclers.tk/conferences/$muc"
                after 400 [LoadHistory $chatid]
            }
        }
    }
    set W [chat::chat_win $chatid]
    $W tag configure URL -underline 1
    $W tag bind URL <Enter> [list $W configure -cursor hand2]
    $W tag bind URL <Leave> [list $W configure -cursor xterm]
    return
}

# -------------------------------------------------------------------------

# Check the HTTP response for redirecting URLs. - PT
proc tclchat::checkForRedirection {tok} {
    set ncode [::http::ncode $tok]
    if {[expr {$ncode == 302 || $ncode == 301 || $ncode == 307}]} {
        upvar \#0 $tok state
        array set meta $state(meta)
        if {[info exists meta(Location)]} {
            return $meta(Location)
        }
    }
    return {}
}

proc tclchat::FetchHistoryIndex {url} {
    variable Options

    set loglist {}
    set tok [::http::geturl ${url}$Options(sel)]
    switch -- [::http::status $tok] {
        ok {
            if {[::http::ncode $tok] >= 500} {
                debugmsg tclchat "error [::http::code $tok]"
            } elseif {[http::ncode $tok] >= 400} {
                debugmsg tclchat "error [::http::code $tok]"
            } else {
                if {[set _url [checkForRedirection $tok]] != {}} {
                    regsub {/\?M=D} $_url {} $_url
                    set loglist [FetchHistoryIndex $_url]
                } else {
                    foreach line [split [::http::data $tok] \n] {
                        if { [regexp -- $Options(RE) $line -> logname size] } {
                            set logname [string map {"%2d" -} $logname]
                            set size [expr {$size / 1024}]k
                            set loglist [linsert $loglist 0 $logname $size]
                        }
                    }
                }
            }
        }
        reset   { debugmsg tclchat "reset" }
        timeout { debugmsg tclchat "timeout" }
        error   { debugmsg tclchat "error [::http::error $tok]" }
        default { debugmsg tclchat "????? [::http::error $tok]" }
    }
    ::http::cleanup $tok
    return $loglist
}

proc tclchat::ParseHistLog {log {reverse 0}} {
    variable Options

    set retList {}
    set MsgRE \
       {^\s*(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun).+?\[([^\]]+)\]\s+([^:]+):?\s*(.*)$}
    set ircRE {ircbridge: \*\*\* (.+) (.+)$}
    set TimeRE {^(.+?)\s+(.+?)\s+(\d{1,2})\s+(\d\d:\d\d:\d\d)\s+(\d{4})}
    set logtime 0

    # fetch log
    set url "$Options(url)/$log"
    debugmsg tclchat "fetch log \"$url\""
    set tok [::http::geturl $url]

    debugmsg tclchat "status [::http::status $tok] [::http::code $tok]"
    switch -- [::http::status $tok] {
        ok {
            # Tcl Jabber logs
            set I [interp create -safe]
            interp alias $I m {} [namespace current]::ParseLogMsg
            if { $reverse } {
                set histTmp [set [namespace current]::History]
                set Options(History) {}
            }
            $I eval [::http::data $tok]
            if { $reverse } {
                set Options(History) [concat $Options(History) $histTmp]
            }
        }
        reset   { debugmsg tclchat "reset" }
        timeout { debugmsg tclchat "timeout" }
        error   { debugmsg tclchat "error [::http::error $tok]" }
        default { debugmsg tclchat "????? [::http::error $tok]" }
    }
    ::http::cleanup $tok
    return $retList
}

# this called on first logon and after a purge
# so not bothering to backgound it
proc tclchat::LoadHistory {chatid} {
    variable Options

    set FinalList {}
    if {$Options(HistoryLines) == 0} {
        # don't even bother

        return
    } elseif {$Options(HistoryLines) < 0} {
        set loglist [FetchHistoryIndex $Options(url)]
        if {[set len [llength $loglist]] > 0} {
            if {$len > 18} {
                set loglist [lrange $loglist 0 17]
            }

            # ask user
            set t [Toplevel .histQ -class dialog]
            wm withdraw $t
            wm transient $t
            wm protocol $t WM_DELETE_WINDOW { }
            wm title $t "Load History From Logs"
            grid [Label $t.lbl \
                    -text "Please select how far back you want to load:"] \
                    -sticky ew -pady 1.25m
            set i 0
            variable HistQueryNum [expr {[llength $loglist] / 2}]
            set loglist [lpairreverse $loglist]
            foreach {l s} $loglist {
                grid [Radiobutton $t.rb$i -text "$l $s" \
                          -val $i -var [namespace current]::HistQueryNum] \
                    -sticky w -padx 4m -pady 0
                incr i
            }
            grid [Radiobutton $t.rb$i -text "None" \
                      -val $i -var [namespace current]::HistQueryNum] \
                -sticky w -padx 4m -pady 0
            grid [Button $t.ok -text Ok -width 8 \
                      -command [list destroy $t] -default active] \
                -sticky e -padx 1.25m -pady 2m
            grid columnconfigure $t 0 -weight 1
            bind $t <Return> [list $t.ok invoke]
            catch {::tk::PlaceWindow $t widget .}
            wm deiconify $t
            tkwait visibility $t
            focus $t.ok
            grab $t
            tkwait window $t
            foreach {l s} [lrange $loglist [expr {$HistQueryNum * 2}] end] {
                debugmsg tclchat "loading history \"$l\" (${s}k)"
                if {[catch {ParseHistLog $l} new]} {
                    debugmsg tclchat "ERROR: $new"
                }
            }
        }
    } else {
        set loglist [FetchHistoryIndex $Options(url)]
        # go thru logs in reverse until N lines loaded
        foreach {log size} $loglist {
            # fetch log
            if {[catch {ParseHistLog $log} new]} {
                debugmsg tclchat "ERROR: $new"
            }
            if {[llength $Options(History)] >= $Options(HistoryLines)} {
                break
            }
        }
    }

    set w [chat::chat_win $chatid]

    # Set a mark for the history insertion point.
    if {[lsearch -exact [$w mark names] HISTORY] == -1} {
        $w config -state normal
        $w insert 0.0 \
            "+++++++++++++++ Loading History +++++++++++++\n"
        $w mark set HISTORY 0.0
        $w config -state disabled
    }

    LoadHistoryLines $chatid

    $w see end
}


proc tclchat::LoadHistoryLines {chatid} {
    variable Options

    set w [chat::chat_win $chatid]
    set state [$w cget -state]
    $w configure -state normal

    if {![info exists Options(History)]} {set Options(History) {}}

    set count 0
    foreach {time nick msg} $Options(History) {
        #$w insert HISTORY "<$nick> $msg\n" [list they NICK-$nick]
        Insert $w $nick $msg $time
        incr count 3
        if {$count > 100} { break }
    }
    $w see end
    set Options(History) [lrange $Options(History) $count end]

    if {$Options(History) == {}} {
        $w configure -state normal
        $w delete "HISTORY + 1 char" "HISTORY + 1 line"
        $w insert "HISTORY + 1 char" \
            "+++++++++++++++ End Of History +++++++++++++\n"
    } else {
        after idle [list [namespace origin LoadHistoryLines] $chatid]
    }

    $w configure -state $state
}

proc tclchat::gotourl {url} {
    debugmsg tclchat "goto url \"$url\""
    browseurl $url
}

proc tclchat::Insert {w nick msg time} {
    variable urlid
    if {[info exists ::plugins::options(delayed_timestamp_format)]} {
        set fmt $::plugins::options(delayed_timestamp_format)
    } else {
        set fmt "\[%m/%d %R\]"
    }

    if {[string equal $nick "ijchain"]} {
        set nick ""
        regexp {^<(\w+)> (.*)$} $msg -> nick msg
    }

    set nk "<$nick>"
    if {[string length $nick] < 1} {set nk "*"}

    $w insert HISTORY \
        [clock format $time -format $fmt] {} \
        "$nk " [list they NICK-$nick]
    while {[regexp -nocase -- {^(.*?)<A.*?HREF="(.+?)".*?>(.*?)</A>(.*?)$} \
                  $msg -> pre url link post]} {
        if {[string length $pre]} {
            $w insert HISTORY $pre [list they NICK-$nick]
        }
        set id URL-[incr urlid]
        $w insert HISTORY $link [list they NICK-$nick URL $id]
        $w tag bind $id <1> [list [namespace origin gotourl] $link]
        set msg $post
    }
    $w insert HISTORY "$msg\n" [list they NICK-$nick]
}

proc tclchat::ParseLogMsg { when nick msg {opts ""} args } {
    variable Options
    set Options(HaveHistory) 1
    set time [clock scan ${when} -gmt 1]
    lappend Options(History) $time $nick $msg
    if {[llength $args] > 0} {
        debugmsg tclchat "WARNING: Log incorrect log format."
    }
    #debugmsg tclchat "[clock format $time] $nick :: $msg $opts $args"
}

proc tclchat::lpairreverse {L} {
    set res {}
    set i [llength $L]
    while {$i} {
        lappend res [lindex $L [incr i -2]] [lindex $L [incr i]]
        incr i -1
    }
    set res
}

proc tclchat::color_to_hex {color} {
    lassign [winfo rgb . $color] r g b
    return [format "%02x%02x%02x" \
                   [expr {$r % 256}] [expr {$g % 256}] [expr {$b % 256}]]
}

# tclchat::add_color --
#
#       In our tclers groupchat window, we want to add additional 'x'
#       elements to add our own color specification.

proc tclchat::add_color {varname chatid user id body type} {
    variable options
    upvar 2 $varname var

    set jid [chat::get_jid $chatid]
    if {$options(use_tkchat_colors) && \
            $type eq "groupchat" && \
            [string match "*@tach.tclers.tk" $jid]} {

        set color [plugins::nickcolors::get_color $user]
        if {[string length $color] > 0} {
            lappend var [::xmpp::xml::create x \
                                -xmlns urn:tkchat:chat \
                                -attrs [list color [color_to_hex $color]]]
        }
    }
}

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