# $Id: xcommands.tcl 1373 2008-02-05 19:19:06Z sergei $
#
# Ad-Hoc Commands support (XEP-0050)
#

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

namespace eval xcommands {
    set winid 0
}

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

proc xcommands::execute {jid node args} {
    set category automation
    foreach {key val} $args {
	switch -- $key {
	    -category { set category $val }
	    -connection { set connid $val }
	}
    }
    if {![info exists connid]} {
	return -code error "Option -connection is mandatory"
    }

    if {$category != "automation"} return

    set vars [list xmlns $::NS(commands) action execute]
    if {$node != ""} {
	lappend vars node $node
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag command \
	     -vars $vars] \
	-command [list [namespace current]::execute_result $connid $jid $node] \
	-to $jid \
	-connection $connid
}

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

proc xcommands::execute_result {connid jid node res child} {
    variable winid

    if {[cequal $res ERR]} {
	incr winid
	set w .xcommands_err$winid

	if {[winfo exists $w]} {
	    destroy $w
	}

	MessageDlg $w -aspect 50000 -icon error \
	    -message [format \
			  [::msgcat::mc "Error executing command: %s"] \
			  [error_to_string $child]] \
	    -type user -buttons ok -default 0 -cancel 0
	return
    }

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set node [jlib::wrapper:getattr $vars node]
    set sessionid [jlib::wrapper:getattr $vars sessionid]
    set status [jlib::wrapper:getattr $vars status]

    draw_window $connid $jid $node $sessionid $status $children
}

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

proc xcommands::draw_window {connid jid node sessionid status xmldata} {
    variable winid

    lassign [find_note $xmldata] type note
    lassign [find_actions $xmldata] actions execute
    # Only jabber:x:data payloads are supported
    set xdata [find_xdata $xmldata]

    switch -- $status {
	executing -
	completed { }
	canceled -
	default { return }
    }

    incr winid
    set w .xcommands$winid

    if {[winfo exists $w]} {
	destroy $w
    }

    Dialog $w -modal none -separator 1 -anchor e -class XData \
	      -default 0 -cancel 1
    set geometry [option get $w geometry XData]
    if {$geometry != ""} {
	wm geometry $w $geometry
    }

    set sw [ScrolledWindow $w.sw]
    set sf [ScrollableFrame $w.fields -constrainedwidth yes]
    set f [$sf getframe]
    $sw setwidget $sf

    set nf [frame $w.note]

    pack_note $nf $type $note
    set focus [data::fill_fields $f $xdata]

    switch -- $status {
	executing {
	    if {[lempty $actions] || \
		    ([llength $actions] == 1 && [lcontain $actions complete])} {
		$w add -text [::msgcat::mc "Submit"] \
		    -command [list [namespace current]::execute_window \
				   $w $connid $jid $node $sessionid complete \
				   [list [namespace current]::complete_result]]
		$w add -text [::msgcat::mc "Cancel"] \
		    -command [list [namespace current]::cancel_window \
				   $w $connid $jid $node $sessionid]
		$w configure -default 0
		set cancel 1
	    } else {
		$w add -text [::msgcat::mc "Prev"] \
		    -state disabled \
		    -command [list [namespace current]::execute_window \
				   $w $connid $jid $node $sessionid prev \
				   [list [namespace current]::next_result]]
		$w add -text [::msgcat::mc "Next"] \
		    -state disabled \
		    -command [list [namespace current]::execute_window \
				   $w $connid $jid $node $sessionid next \
				   [list [namespace current]::next_result]]
		$w add -text [::msgcat::mc "Finish"] \
		    -state disabled \
		    -command [list [namespace current]::execute_window \
				   $w $connid $jid $node $sessionid complete \
				   [list [namespace current]::complete_result]]
		$w add -text [::msgcat::mc "Cancel"] \
		    -command [list [namespace current]::cancel_window \
				   $w $connid $jid $node $sessionid]
		set_default_button $w $actions $execute
		set cancel 3
		
	    }
	}
	completed {
	    $w add -text [::msgcat::mc "Close"] \
		-command [list [namespace current]::close_window $w]
	    $w configure -default 0
	    set cancel 0
	}
    }
    # Can't configure -cancel option because of bug in BWidget
    # $w configure -cancel $cancel
    bind $w <Escape> "$w invoke $cancel"
    bind $w <Destroy> [list data::cleanup $f]

    bindscroll $f $sf

    #pack [Separator $w.sep] -side bottom -fill x  -pady 1m

    pack $nf -side top -expand no -fill x -padx 2m -pady 0m -in [$w getframe]
    pack $sw -side top -expand yes -fill both -padx 2m -pady 2m -in [$w getframe]

    update idletasks
    $nf configure -width [expr {[winfo reqwidth $f] + [winfo pixels $f 1c]}]

    if {$focus != ""} {
	$w draw $focus
    } else {
	$w draw
    }

    return $w
}

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

proc xcommands::execute_window {w connid jid node sessionid action cmd} {
    # Send requested data and wait for result

    set vars [list xmlns $::NS(commands) sessionid $sessionid action $action]
    if {$node != ""} {
	lappend vars node $node
    }

    set f [$w.fields getframe]

    jlib::send_iq set \
	[jlib::wrapper:createtag command \
	     -vars $vars \
	     -subtags [data::get_tags $f]] \
	-command [list $cmd $w $connid $jid $node $sessionid] \
	-to $jid \
	-connection $connid
}

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

proc xcommands::pack_note {fr type note} {
    set mf $fr.msg
    if {[winfo exists $mf]} {
	destroy $mf
    }

    if {$note == ""} return

    switch -- $type {
	warn {
	    set msg [::msgcat::mc "Warning:"]
	}
	error {
	    set msg [::msgcat::mc "Error:"]
	}
	default {
	    set msg [::msgcat::mc "Info:"]
	}
    }
    message $mf -text "$msg $note" -aspect 50000 -width 0
    pack $mf
}

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

proc xcommands::set_default_button {bbox actions execute} {
    set default -1
    foreach action $actions {
	switch -- $action {
	    prev {
		$bbox itemconfigure 0 -state normal
		if {$default == -1} {
		    set default 0
		}
	    }
	    next {
		$bbox itemconfigure 1 -state normal
		set default 1
	    }
	    complete {
		$bbox itemconfigure 2 -state normal
		if {$default == -1 || $default == 0} {
		    set default 2
		}
	    }
	}
    }
    if {$default != -1} {
	$bbox configure -default $default
    } else {
	$bbox itemconfigure 1 -state normal
	$bbox configure -default 1
    }
    switch -- $execute {
	prev {
	    $bbox itemconfigure 0 -state normal
	    $bbox configure -default 0
	}
	next {
	    $bbox itemconfigure 1 -state normal
	    $bbox configure -default 1
	}
	complete {
	    $bbox itemconfigure 2 -state normal
	    $bbox configure -default 2
	}
    }
}

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

proc xcommands::next_result {w connid jid node sessionid res child} {
    variable winid

    set f [$w.fields getframe]

    foreach cw [winfo children $f] {
	destroy $cw
    }

    data::cleanup $f

    if {[cequal $res ERR]} {
	incr winid
	set w .xcommands_err$winid

	if {[winfo exists $w]} {
	    destroy $w
	}

	MessageDlg $w -aspect 50000 -icon error \
	    -message [format \
			  [::msgcat::mc "Error executing command: %s"] \
			  [error_to_string $child]] \
	    -type user -buttons ok -default 0 -cancel 0
	return
    }

    # TODO
    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set node [jlib::wrapper:getattr $vars node]
    set sessionid [jlib::wrapper:getattr $vars sessionid]
    set status [jlib::wrapper:getattr $vars status]

    destroy $w
    draw_window $connid $jid $node $sessionid $status $children
}

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

proc xcommands::complete_result {w connid jid node sessionid res child} {
    variable winid

    if {[cequal $res ERR]} {
	incr winid
	set w .xcommands_err$winid

	if {[winfo exists $w]} {
	    destroy $w
	}

	MessageDlg $w -aspect 50000 -icon error \
	    -message [format \
			  [::msgcat::mc "Error completing command: %s"] \
			  [error_to_string $child]] \
	    -type user -buttons ok -default 0 -cancel 0
	return
    }

    # TODO
    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set node [jlib::wrapper:getattr $vars node]
    set sessionid [jlib::wrapper:getattr $vars sessionid]
    set status [jlib::wrapper:getattr $vars status]

    switch -- $status {
	executing -
	completed { }
	canceled -
	default { return }
    }

    lassign [find_note $children] type note
    lassign [find_actions $children] actions execute
    # Only jabber:x:data payloads are supported
    set xdata [find_xdata $children]

    set f [$w.fields getframe]

    foreach cw [winfo children $f] {
	destroy $cw
    }

    data::cleanup $f

    set nf $w.note

    pack_note $nf $type $note
    set focus [data::fill_fields $f $xdata]

    destroy $w
    draw_window $connid $jid $node $sessionid $status $children
}

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

proc xcommands::cancel_window {w connid jid node sessionid} {
    # Send cancelling stanza and ignore reply or error

    set vars [list xmlns $::NS(commands) sessionid $sessionid action cancel]
    if {$node != ""} {
	lappend vars node $node
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag command -vars $vars] \
	-to $jid \
	-connection $connid

    set f [$w.fields getframe]
    data::cleanup $f

    destroy $w
}

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

proc xcommands::close_window {w} {
    set f [$w.fields getframe]
    data::cleanup $f

    destroy $w
}

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

proc xcommands::find_actions {xmldata} {
    set actions {}
    set execute next
    foreach child $xmldata {
	jlib::wrapper:splitxml $child tag vars isempty chdata children
	if {$tag == "actions"} {
	    if {[jlib::wrapper:isattr $vars execute]} {
		set execute [jlib::wrapper:getattr $vars execute]
	    }
	    foreach child1 $children {
		jlib::wrapper:splitxml $child1 tag1 vars1 isempty1 chdata1 children1
		switch -- $tag1 {
		    prev -
		    next -
		    complete { lappend actions $tag1 }
		}
	    }
	    if {![lcontain $actions $execute]} {
		set execute next
	    }
	}
    }
    return [list $actions $execute]
}

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

proc xcommands::find_xdata {xmldata} {
    set xdata {}
    foreach child $xmldata {
	jlib::wrapper:splitxml $child tag vars isempty chdata children
	if {[jlib::wrapper:getattr $vars xmlns] == $::NS(data)} {
	    lappend xdata $child
	}
    }
    return $xdata
}

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

proc xcommands::find_note {xmldata} {
    set note ""
    set type info
    foreach child $xmldata {
	jlib::wrapper:splitxml $child tag vars isempty chdata children
	if {$tag == "note"} {
	    set note [string trim $chdata]
	    set type [jlib::wrapper:getattr $vars type]
	    switch -- $type {
		info -
		warn -
		error { }
		default { set type info }
	    }
	}
    }
    return [list $type $note]
}

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

proc xcommands::register_namespace {} {
    disco::browser::register_feature_handler $::NS(commands) \
	[namespace current]::execute -node 1 \
	-desc [list automation [::msgcat::mc "Execute command"]]
    disco::register_featured_node $::NS(commands) $::NS(commands) \
				  [::msgcat::mc "Commands"]
}

hook::add postload_hook [namespace current]::xcommands::register_namespace

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

