# Tkabber debugging procedures
# (c) Marshall T. Rose
#
# Some tweaks by Badlop
#
# Options changed by Sergei Golovan
#
# $Id$

package require msgcat

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
			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:debug]] == 0} {
	    rename ::${ns}::Debug ::${ns}::Debug:debug
	    proc ::${ns}::Debug {xlib level str} \
		 "[namespace current]::debugmsg $ns \"\$xlib \$str\""
	}
    }

    if {[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 plugins}]} {
	setup_menu
    }
}

proc debug::unload {} {
    variable debug_fd

    if {![catch {.mainframe getmenu plugins}]} {
	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 {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 plugins]

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

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
}

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 focus $dw.body]}]} {
	    # Main window isn't created yet
	    return
	}

        [ScrolledWindow $dw.sw] setwidget \
            [text $dw.body -yscrollcommand [list $dw.scroll set] \
		 -state disabled -takefocus 1]
	bind $dw.body <1> [list focus $dw.body]

        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
}

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
    focus $w.body
}

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 $w.body <<OpenSearchPanel>> \
	[double% [list [namespace current]::open_panel $w $sf]]
}

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