# $Id: rawxml.tcl 1429 2008-05-18 12:36:02Z sergei $

option add *RawXML.inforeground       DarkRed     widgetDefault
option add *RawXML.outforeground      DarkBlue    widgetDefault
option add *RawXML.intagforeground    DarkRed     widgetDefault
option add *RawXML.inattrforeground   DarkRed     widgetDefault
option add *RawXML.invalueforeground  Purple4     widgetDefault
option add *RawXML.incdataforeground  SteelBlue   widgetDefault
option add *RawXML.outtagforeground   DarkMagenta widgetDefault
option add *RawXML.outattrforeground  DarkMagenta widgetDefault
option add *RawXML.outvalueforeground DarkGreen   widgetDefault
option add *RawXML.outcdataforeground DarkBlue    widgetDefault
option add *RawXML.inputheight        4           widgetDefault


namespace eval rawxml {
    custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
    custom::defgroup RawXML \
	[::msgcat::mc "Options for Raw XML Input module,\
which allows you to monitor\
incoming/outgoing traffic from connection to server and send\
custom XML stanzas."] -group Plugins -tag "Raw XML Input"
	 
    #set options(pretty_print) 0
    custom::defvar options(pretty_print) 0 \
	[::msgcat::mc "Pretty print incoming and outgoing XML stanzas."] \
	-group RawXML -type boolean
    #set options(indent) 2
    custom::defvar options(indent) 2 \
	[::msgcat::mc "Indentation for pretty-printed XML subtags."] \
	-group RawXML -type integer

    set pass 0
    variable tabs
}


proc rawxml::handle_inout {connid text prefix tag} {
    variable options
    variable pass

    set w .rawxml
    if {![winfo exists $w]} return
    if {$options(pretty_print) && ($tag != "out" || $pass)} {
	set pass 0
	return
    }

    set dump $w.dump
    $dump configure -state normal

    set scroll [expr {[lindex [$dump yview] 1] == 1}]

    set id "($connid)"
    catch {set id "($connid,[jlib::connection_jid $connid])"}

    $dump insert end \
	"$prefix$id:\n" {} \
	"$text" $tag

    if {![$dump compare "end -1 chars linestart" == "end -1 chars"]} {
	$dump insert end "\n"
    }

    if {$scroll} {
	after idle [list $dump yview moveto 1]
    }

    $dump configure -state disabled
}

proc rawxml::handle_inout_x {connid xml prefix tag} {
    variable options
    variable pass

    set w .rawxml
    if {![winfo exists $w]} return
    if {!$options(pretty_print)} return
    if {$tag == "out"} {set pass 1}

    set dump $w.dump
    $dump configure -state normal

    set scroll [expr {[lindex [$dump yview] 1] == 1}]

    set id "($connid)"
    catch {set id "($connid,[jlib::connection_jid $connid])"}

    $dump insert end "$prefix$id:\n"

    pretty_print $dump $xml "" $tag

    if {![$dump compare "end -1 chars linestart" == "end -1 chars"]} {
	$dump insert end "\n"
    }

    if {$scroll} {
	$dump see end
    }

    $dump configure -state disabled
}

proc rawxml::pretty_print {t xmldata prefix tag {xmlns jabber:client}} {
    variable options
    variable tabs

    jlib::wrapper:splitxml $xmldata tagname vars isempty chdata subtags

    set vars1 {}
    foreach {attr value} $vars {
	if {$attr == "xmlns"} {
	    if {$value == $xmlns} {
		continue
	    } else {
		set xmlns $value
	    }
	}
	lappend vars1 $attr $value
    }

    $t insert end "$prefix<" {} $tagname ${tag}tag
    if {[llength $vars1] != 0} {
	#set attrprefix ${prefix}[string repeat " " \
	#			     [expr {[clength $tagname] + 2}]]
	set arr_index "$prefix<$tagname "
	if {![info exists tabs($arr_index)]} {
	    set tabs($arr_index) [font measure [$t cget -font] $arr_index]
	}
	$t tag configure $arr_index -tabs [list $tabs($arr_index)]

	set vars2 [lassign $vars1 attr value]
	$t insert end \
	    " $attr" ${tag}attr \
	    "=" {} \
	    "'[jlib::wrapper:xmlcrypt $value]'" ${tag}value
	foreach {attr value} $vars2 {
	    $t insert end \
		"\n\t$attr" [list ${tag}attr $arr_index]\
		"=" {} \
		"'[jlib::wrapper:xmlcrypt $value]'" ${tag}value
	}
    }
    if {$chdata == "" && [llength $subtags] == 0} {
	$t insert end "/>\n"
	return
    } else {
	$t insert end ">"
    }

    if {$subtags == {}} {
	$t insert end [jlib::wrapper:xmlcrypt $chdata] ${tag}cdata
	$t insert end "</" {} $tagname ${tag}tag ">\n"
    } else {
	$t insert end "\n"
        foreach subdata $subtags {
	    pretty_print $t $subdata \
		$prefix[string repeat " " $options(indent)] $tag \
		$xmlns
	}
	$t insert end "$prefix</" {} $tagname ${tag}tag ">\n"
    }
}

proc ::LOG_INPUT {connid t} \
    "[namespace current]::rawxml::handle_inout \$connid \$t IN in"
proc ::LOG_OUTPUT {connid t} \
    "[namespace current]::rawxml::handle_inout \$connid \$t OUT out"
proc ::LOG_INPUT_XML {connid x} \
    "[namespace current]::rawxml::handle_inout_x \$connid \$x IN in"
proc ::LOG_OUTPUT_XML {connid x} \
    "[namespace current]::rawxml::handle_inout_x \$connid \$x OUT out"

proc rawxml::open_window {} {
    set w .rawxml
    if {[winfo exists $w]} {
	return
    }

    add_win $w -title [::msgcat::mc "Raw XML"] \
	-tabtitle [::msgcat::mc "Raw XML"] \
	-class RawXML \
	-raisecmd [list focus $w.input] \
	-raise 1


    set tools [frame $w.tools]
    pack $tools -side top -anchor w -fill x

    checkbutton $tools.pp -text [::msgcat::mc "Pretty print XML"] \
	-variable [namespace current]::options(pretty_print)
    pack $tools.pp -side left -anchor w

    menubutton $tools.templates -text [::msgcat::mc "Templates"] \
    	-relief $::tk_relief \
	-menu .rawxml.tools.templates.root
    pack $tools.templates -side left -anchor w
    create_template_menu

    button $tools.clear -text [::msgcat::mc "Clear"] \
        -command "
                [list $w.dump] configure -state normal
                [list $w.dump] delete 0.0 end
                [list $w.dump] configure -state disabled
        "
    pack $tools.clear -side left -anchor w

    PanedWin $w.pw -side right -pad 0 -width 4
    pack $w.pw -fill both -expand yes

    set uw [PanedWinAdd $w.pw -weight 1 -minsize 100]
    set dw [PanedWinAdd $w.pw -weight 0 -minsize 32]


    set isw [ScrolledWindow $w.isw -scrollbar vertical]
    pack $isw -side bottom -fill both -expand yes -in $dw
    set input [textUndoable $w.input \
		   -height [option get $w inputheight RawXML]]
    $isw setwidget $input
    [winfo parent $dw] configure -height [winfo reqheight $input]

    set sw [ScrolledWindow $w.sw -scrollbar vertical]
    pack $sw -side top -fill both -expand yes -in $uw
    set dump [text $w.dump]
    $sw setwidget $dump

    $dump configure -state disabled

    bind $input <Control-Key-Return> "
	[namespace current]::send_xml
	break"

    $dump tag configure in \
	-foreground [option get $w inforeground RawXML]
    $dump tag configure out \
	-foreground [option get $w outforeground RawXML]

    $dump tag configure intag \
	-foreground [option get $w intagforeground RawXML]
    $dump tag configure inattr \
	-foreground [option get $w inattrforeground RawXML]
    $dump tag configure invalue \
	-foreground [option get $w invalueforeground RawXML]
    $dump tag configure incdata \
	-foreground [option get $w incdataforeground RawXML]

    $dump tag configure outtag \
	-foreground [option get $w outtagforeground RawXML]
    $dump tag configure outattr \
	-foreground [option get $w outattrforeground RawXML]
    $dump tag configure outvalue \
	-foreground [option get $w outvalueforeground RawXML]
    $dump tag configure outcdata \
	-foreground [option get $w outcdataforeground RawXML]

    variable history
    bind $input <Control-Key-Up> \
	[list [namespace current]::history_move 1]
    bind $input <Control-Key-Down> \
	[list [namespace current]::history_move -1]

    set history(stack) [list {}]
    set history(pos) 0

    regsub -all %W [bind Text <Prior>] $dump prior_binding
    regsub -all %W [bind Text <Next>] $dump next_binding
    bind $input <Meta-Prior> $prior_binding
    bind $input <Meta-Next> $next_binding
    bind $input <Alt-Prior> $prior_binding
    bind $input <Alt-Next> $next_binding

    hook::run open_rawxml_post_hook $w
}

proc rawxml::history_move {shift} {
    variable history

    set newpos [expr $history(pos) + $shift]

    if {!($newpos < 0 || $newpos >= [llength $history(stack)])} {
	set iw .rawxml.input
	set body [$iw get 1.0 "end -1 chars"]

	if {$history(pos) == 0} {
	    set history(stack) \
		[lreplace $history(stack) 0 0 $body]
	}

	set history(pos) $newpos
	set newbody [lindex $history(stack) $newpos]
	$iw delete 1.0 end
	$iw insert 0.0 $newbody
    }
}

proc rawxml::send_xml {} {
    variable history

    set input .rawxml.input
    set xml [$input get 0.0 "end - 1c"]

    lvarpush history(stack) $xml 1
    set history(pos) 0

    if {[llength [::jlib::connections]] == 0} {
	return -code error [::msgcat::mc "Not connected"]
    } else {
	set connid [lindex [::jlib::connections] 0]
	jlib::outmsg $xml -connection $connid
    }
    $input delete 1.0 end
}


proc rawxml::setup_menu {} {
    catch { 
        set m [.mainframe getmenu admin]

        $m add command -label [::msgcat::mc "Open raw XML window"] \
	    -command [namespace current]::open_window
    }
}
hook::add finload_hook [namespace current]::rawxml::setup_menu


proc rawxml::add_template_group {parent group name} {
    set m .rawxml.tools.templates.$group
    set mparent .rawxml.tools.templates.$parent

    if {![winfo exists $m]} {
	menu $m -tearoff 0
    }

    $mparent add cascade -label $name -menu $m
}

proc rawxml::add_template {group name xmldata} {
    set m .rawxml.tools.templates.$group
    set input .rawxml.input

    $m add command -label $name \
	-command [list [namespace current]::pretty_print \
		      $input $xmldata "" template]
}


proc rawxml::create_template_menu {} {
    if {[winfo exists .rawxml.tools.templates.root]} {
	destroy .rawxml.tools.templates.root
    } else {
	menu .rawxml.tools.templates.root -tearoff 0
    }

    add_template_group root message [::msgcat::mc "Message"]

    add_template message [::msgcat::mc "Normal message"] \
	[jlib::wrapper:createtag message \
	     -vars {to "" type normal} \
	     -subtags [list [jlib::wrapper:createtag body -chdata " "]]]

    add_template message [::msgcat::mc "Chat message"] \
	[jlib::wrapper:createtag message \
	     -vars {to "" type chat} \
	     -subtags [list [jlib::wrapper:createtag body -chdata " "]]]

    add_template message [::msgcat::mc "Headline message"] \
	[jlib::wrapper:createtag message \
	     -vars {to "" type headline} \
	     -subtags [list [jlib::wrapper:createtag subject -chdata " "] \
			    [jlib::wrapper:createtag body -chdata " "] \
			    [jlib::wrapper:createtag x \
				 -vars {xmlns jabber:x:oob} \
				 -subtags [list [jlib::wrapper:createtag url -chdata " "] \
						[jlib::wrapper:createtag desc -chdata " "]]]]]

    add_template_group root presence [::msgcat::mc "Presence"]

    add_template presence [::msgcat::mc "Available presence"] \
	[jlib::wrapper:createtag presence \
	     -vars {to ""} \
	     -subtags [list \
			   [jlib::wrapper:createtag status -chdata " "] \
			   [jlib::wrapper:createtag show -chdata " "] \
			  ]]

    add_template presence [::msgcat::mc "Unavailable presence"] \
	[jlib::wrapper:createtag presence \
	     -vars {to "" type unavailable} \
	     -subtags [list \
			   [jlib::wrapper:createtag status -chdata " "] \
			  ]]




    add_template_group root iq [::msgcat::mc "IQ"]

    add_template iq [::msgcat::mc "Generic IQ"] \
	[jlib::wrapper:createtag iq \
	     -vars {to "" type "" id ""} \
	     -subtags [list \
			   [jlib::wrapper:createtag query \
				-vars {xmlns ""}]]]

    add_template iq "jabber:iq:time get" \
	[jlib::wrapper:createtag iq \
	     -vars {to "" type get id ""} \
	     -subtags [list \
			   [jlib::wrapper:createtag query \
				-vars {xmlns jabber:iq:time}]]]

    add_template iq "jabber:iq:version get" \
	[jlib::wrapper:createtag iq \
	     -vars {to "" type get id ""} \
	     -subtags [list \
			   [jlib::wrapper:createtag query \
				-vars {xmlns jabber:iq:version}]]]

    add_template iq "jabber:iq:last get" \
	[jlib::wrapper:createtag iq \
	     -vars {to "" type get id ""} \
	     -subtags [list \
			   [jlib::wrapper:createtag query \
				-vars {xmlns jabber:iq:last}]]]



    add_template_group iq pubsub [::msgcat::mc "Pub/sub"]

    pubsub_template [::msgcat::mc "Create node"] set \
	[jlib::wrapper:createtag create \
	     -vars {node ""}]
    pubsub_template [::msgcat::mc "Publish node"] set \
	[jlib::wrapper:createtag publish \
	     -vars {node ""} \
	     -subtags [list [jlib::wrapper:createtag item]]]
    pubsub_template [::msgcat::mc "Retract node"] set \
	[jlib::wrapper:createtag retract \
	     -vars {node ""} \
	     -subtags [list [jlib::wrapper:createtag item]]]
    pubsub_template [::msgcat::mc "Subscribe to a node"] set \
	[jlib::wrapper:createtag subscribe \
	     -vars {node "" jid ""}]
    pubsub_template [::msgcat::mc "Unsubscribe from a node"] set \
	[jlib::wrapper:createtag unsubscribe \
	     -vars {node "" jid ""}]
    pubsub_template [::msgcat::mc "Get items"] get \
	[jlib::wrapper:createtag items \
	     -vars {node ""}]
}

proc rawxml::pubsub_template {name type subtag} {
    add_template pubsub $name \
	[jlib::wrapper:createtag iq \
	     -vars [list to "" type $type id ""] \
	     -subtags [list \
			   [jlib::wrapper:createtag pubsub \
				-vars [list xmlns \
					   http://jabber.org/protocol/pubsub] \
				-subtags [list $subtag]]]]
}

##############################################################################

proc rawxml::restore_window {args} {
    open_window
}

proc rawxml::save_session {vsession} {
    upvar 2 $vsession session
    global usetabbar

    # We don't need JID at all, so make it empty (special case)
    set user     ""
    set server   ""
    set resource ""

    # TODO
    if {!$usetabbar} return

    set prio 0
    foreach page [.nb pages] {
	set path [ifacetk::nbpath $page]

	if {[string equal $path .rawxml]} {
	    lappend session [list $prio $user $server $resource \
		[list [namespace current]::restore_window] \
	    ]
	}
	incr prio
    }
}

hook::add save_session_hook [namespace current]::rawxml::save_session

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