# debug.tcl --
#
#       This file implements Debug plugin for the Tkabber XMPP client.
#       It allows one to log Tkabber debug messages into a file or a
#       log window.
#
# Author: Marshall T. Rose
# Modifications: Badlop
# Modifications: Sergei Golovan

package require msgcat
catch {package require Tclx}

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

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

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

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

    custom::defvar options(log_to_file) 0 \
        [::msgcat::mc "Log debug messages to file %s." \
                      [file join $::configdir tkabber.log]] \
        -group Debug \
        -type boolean

    custom::defvar options(log_to_window) 0 \
        [::msgcat::mc "Log debug messages to a separate tab/window."] \
        -group Debug \
        -type boolean

    variable modules   {attline
                        avatar
                        browser
                        browseurl
                        caps
                        chat
                        conference
                        custom
                        disco
                        emoticons
                        filetransfer
                        filters
                        georoster
                        gpg
                        headlines
                        hook
                        http
                        iface
                        iq
                        jidlink
                        logger
                        login
                        message
                        mucignore
                        negotiate
                        nick
                        otr
                        pconnect::https
                        pconnect::socks4
                        pconnect::socks5
                        pep
                        plugins
                        popupmenu
                        presence
                        privacy
                        pubsub
                        register
                        richtext
                        roster
                        search
                        si
                        ssj
                        sw
                        tclchat
                        tkabber
                        userinfo
                        utils
                        warning
                        xmpp
                        xmpp::transport::bosh
                        xmpp::transport::poll
                        zerobot}

    foreach module $modules {
        custom::defvar debug($module) 0 \
            [::msgcat::mc "Log debug messages for module %s to a tab/window." \
                          $module] \
            -group Debug -type boolean
    }
}

proc debug::load {} {
    if {[llength [info procs ::debugmsg:debug]] == 0} {
        rename ::debugmsg ::debugmsg:debug
        proc ::debugmsg {module msg} \
             "[namespace current]::debugmsg \$module \$msg"
    }

    foreach ns {otr
                pconnect::https
                pconnect::socks4
                pconnect::socks5
                xmpp
                xmpp::transport::bosh
                xmpp::transport::poll} {
        if {[llength [info procs ::${ns}::Debug]] > 0 && \
                [llength [info procs ::${ns}::Debug:debug]] == 0} {
            rename ::${ns}::Debug ::${ns}::Debug:debug
            proc ::${ns}::Debug {xlib level str} \
                 "[namespace current]::debugmsg $ns \"\$xlib \$str\""
        }
    }

    foreach ns {gpg} {
        if {[llength [info procs ::${ns}::Debug]] > 0 && \
                [llength [info procs ::${ns}::Debug:debug]] == 0} {
            rename ::${ns}::Debug ::${ns}::Debug:debug
            proc ::${ns}::Debug {level str} \
                 "[namespace current]::debugmsg $ns \"\$str\""
        }
    }

    if {[llength [info procs ::otr::smp::Debug]] > 0 && \
            [llength [info procs ::otr::smp::Debug:debug]] == 0} {
        rename ::otr::smp::Debug ::otr::smp::Debug:debug
        proc ::otr::smp::Debug {level str} \
             "[namespace current]::debugmsg otr \$str"
    }

    hook::add finload_hook [namespace current]::setup_menu

    if {![catch {.mainframe getmenu debug}]} {
        setup_menu
    }
}

proc debug::unload {} {
    variable debug_fd

    if {![catch {.mainframe getmenu debug}]} {
        destroy_menu
    }

    if {[info exists debug_fd]} {
        close $debug_fd
        unset debug_fd
    }

    if {[winfo exists .debug]} {
        destroy_win .debug
    }

    hook::remove finload_hook [namespace current]::setup_menu

    foreach ns {gpg
                otr
                pconnect::https
                pconnect::socks4
                pconnect::socks5
                xmpp
                xmpp::transport::bosh
                xmpp::transport::poll} {
        if {[llength [info procs ::${ns}::Debug:debug]] > 0} {
            rename ::${ns}::Debug ""
            rename ::${ns}::Debug:debug ::${ns}::Debug
        }
    }

    if {[llength [info procs ::otr::smp::Debug:debug]] > 0} {
        rename ::otr::smp::Debug ""
        rename ::otr::smp::Debug:debug ::otr::smp::Debug
    }

    if {[llength [info procs ::debugmsg:debug]] > 0} {
        rename ::debugmsg ""
        rename ::debugmsg:debug ::debugmsg
    }

    namespace delete [namespace current]::search
}

proc debug::destroy_menu {} {
    set m [.mainframe getmenu debug]

    if {![catch {$m index [::msgcat::mc "Debug"]} idx] && \
            ![string equal $idx none]} {
        set mm [$m entrycget $idx -menu]
        $m delete $idx
        destroy $mm
    }

    if {![catch {$m index [::msgcat::mc "Profile on"]} idx] && \
            ![string equal $idx none]} {
        $m delete $idx
    }

    if {![catch {$m index [::msgcat::mc "Profile report"]} idx] && \
            ![string equal $idx none]} {
        $m delete $idx
    }
}

proc debug::setup_menu {} {
    variable options
    variable modules
    variable debug

    set m [.mainframe getmenu debug]

    if {![catch {$m index [::msgcat::mc "Debug"]} idx] && \
            ![string equal $idx none]} {
        return
    }

    set buttons [menu $m.devel -tearoff $ifacetk::options(show_tearoffs)]

    $buttons add checkbutton -label [::msgcat::mc "Log to file"] \
        -variable [namespace current]::options(log_to_file)
    $buttons add checkbutton -label [::msgcat::mc "Log to window"] \
        -variable [namespace current]::options(log_to_window)

    $buttons add separator

    set n 0
    foreach module $modules {
        if {$n == 0} {
            set submodules [list $module]
        } else {
            lappend submodules $module
        }
        incr n
        if {$n == 8 || $module == [lindex $modules end]} {
            set n 0
            set me [menu $buttons.[string map {:: #} [lindex $submodules 0]] \
                         -tearoff $::ifacetk::options(show_tearoffs)]
            $buttons add cascade \
                     -label [lindex $submodules 0]-[lindex $submodules end] \
                     -menu $me
            foreach mod $submodules {
                $me add checkbutton -label $mod \
                    -variable [namespace current]::debug($mod)
            }
        }
    }

    $m add cascade -label [::msgcat::mc "Debug"] -menu $buttons

    if {[llength [info commands profile]] > 0} {
        $m add command -label [::msgcat::mc "Profile on"] \
           -command {
                profile -commands -eval on
            }
        $m add command -label [::msgcat::mc "Profile report"] \
           -command {
                profile off profil
                profrep profil real profresults
            }
    }
}

proc debug::debugmsg {module msg} {
    variable options
    variable debug
    variable debug_fd

    if {$options(log_to_file)} {
        if {![info exists debug_fd]} {
            catch { file rename -force -- $::configdir/tkabber.log \
                                          $::configdir/tkabber0.log }
            set debug_fd [open $::configdir/tkabber.log w]
            fconfigure $debug_fd -buffering line
        }

        puts $debug_fd [format "%s %-12.12s %s %s" \
                            [clock format [clock seconds] -format "%m/%d %T"] \
                            $module [lindex [info level -2] 0] $msg]
    }

    if {!$options(log_to_window) || ![info exists debug($module)] || \
            !$debug($module)} {
        return
    }

    set dw .debug

    if {![winfo exists $dw]} {
        if {[catch {
                add_win $dw \
                    -title [::msgcat::mc Debug] \
                    -tabtitle [::msgcat::mc Debug] \
                    -class Chat \
                    -raisecmd [list [namespace current]::focus_body $dw]
            }]} {
            # Main window isn't created yet
            return
        }

        [ScrolledWindow $dw.sw] setwidget \
            [Text $dw.body -yscrollcommand [list $dw.scroll set] \
                 -state disabled -takefocus 1]
        bind [Wrapped $dw.body] <1> [list [namespace current]::focus_body \
                                          [double% $dw]]

        pack $dw.sw -side bottom -fill both -expand yes

        $dw.body tag configure module \
            -foreground [option get $dw theyforeground Chat]
        $dw.body tag configure proc   \
            -foreground [option get $dw meforeground Chat]
        $dw.body tag configure error  \
            -foreground [option get $dw errforeground Chat]

        search::setup_panel $dw
    }

    $dw.body configure -state normal

    set scroll [expr {[lindex [$dw.body yview] 1] == 1}]

    $dw.body insert end \
             [format "%s: %-12.12s" \
                     [clock format [clock seconds] -format "%m/%d %T"] \
                     $module] module " "
    set tag normal

    $dw.body insert end [lindex [info level -2] 0] proc " "

    $dw.body insert end [string trimright $msg] $tag
    $dw.body insert end "\n\n"

    if {$scroll} {
        $dw.body see end
    }

    $dw.body configure -state disabled
}

proc debug::focus_body {w} {
    focus [Wrapped $w.body]
}

namespace eval debug::search {}

proc debug::search::open_panel {w sf} {
    pack $sf -side bottom -anchor w -fill x -before $w.sw
    update idletasks
    $w.body see end
}

proc debug::search::close_panel {w sf} {
    $w.body tag remove search_highlight 0.0 end
    pack forget $sf
    [namespace parent]::focus_body $w
}

proc debug::search::setup_panel {w} {
    set body $w.body

    $body mark set sel_start end
    $body mark set sel_end 0.0

    set sf [plugins::search::spanel [winfo parent $body].search \
                -searchcommand [list ::plugins::search::do_text_search $body] \
                -closecommand [list [namespace current]::close_panel $w]]

    bind [Wrapped $body] <<OpenSearchPanel>> \
         [double% [list [namespace current]::open_panel $w $sf]]
}

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