1# $Id$
2#
3# Ad-Hoc Commands support (XEP-0050)
4#
5
6##########################################################################
7
8namespace eval xcommands {
9    set winid 0
10}
11
12##########################################################################
13
14proc xcommands::execute {xlib jid node args} {
15    set category automation
16    foreach {key val} $args {
17	switch -- $key {
18	    -category { set category $val }
19	}
20    }
21    if {$category != "automation"} return
22
23    set vars [list action execute]
24    if {$node != ""} {
25	lappend vars node $node
26    }
27
28    ::xmpp::sendIQ $xlib set \
29	-query [::xmpp::xml::create command \
30			-xmlns $::NS(commands) \
31			-attrs $vars] \
32	-command [list [namespace current]::execute_result $xlib $jid $node] \
33	-to $jid
34}
35
36##########################################################################
37
38proc xcommands::execute_result {xlib jid node res child} {
39    variable winid
40
41    if {[string equal $res error]} {
42	incr winid
43	set w .xcommands_err$winid
44
45	if {[winfo exists $w]} {
46	    destroy $w
47	}
48
49	MessageDlg $w -aspect 50000 -icon error \
50	    -message [format \
51			  [::msgcat::mc "Error executing command: %s"] \
52			  [error_to_string $child]] \
53	    -type user -buttons ok -default 0 -cancel 0
54	return
55    }
56
57    ::xmpp::xml::split $child tag xmlns attrs cdata subels
58
59    set node [::xmpp::xml::getAttr $attrs node]
60    set sessionid [::xmpp::xml::getAttr $attrs sessionid]
61    set status [::xmpp::xml::getAttr $attrs status]
62
63    draw_window $xlib $jid $node $sessionid $status $subels
64}
65
66##########################################################################
67
68proc xcommands::draw_window {xlib jid node sessionid status xmldata} {
69    variable winid
70
71    lassign [find_note $xmldata] type note
72    lassign [find_actions $xmldata] actions execute
73
74    # Only jabber:x:data payloads are supported
75    lassign [::xmpp::data::findForm $xmldata] type form
76    set xdata [::xmpp::data::parseForm $form]
77
78    switch -- $status {
79	executing -
80	completed { }
81	canceled -
82	default { return }
83    }
84
85    incr winid
86    set w .xcommands$winid
87
88    if {[winfo exists $w]} {
89	destroy $w
90    }
91
92    Dialog $w -transient 0 \
93	      -modal none  \
94	      -separator 1 \
95	      -anchor e    \
96	      -class XData \
97	      -default 0   \
98	      -cancel 1
99    set geometry [option get $w geometry XData]
100    if {$geometry != ""} {
101	wm geometry $w $geometry
102    }
103
104    set sw [ScrolledWindow $w.sw]
105    set sf [ScrollableFrame $w.fields -constrainedwidth yes]
106    set f [$sf getframe]
107    $sw setwidget $sf
108
109    set nf [frame $w.note]
110
111    pack_note $nf $type $note
112    set focus [data::fill_fields_x $f $xdata]
113
114    switch -- $status {
115	executing {
116	    if {[lempty $actions] || \
117		    ([llength $actions] == 1 && [lcontain $actions complete])} {
118		$w add -text [::msgcat::mc "Submit"] \
119		    -command [list [namespace current]::execute_window \
120				   $w $xlib $jid $node $sessionid complete \
121				   [list [namespace current]::complete_result]]
122		$w add -text [::msgcat::mc "Cancel"] \
123		    -command [list [namespace current]::cancel_window \
124				   $w $xlib $jid $node $sessionid]
125		$w configure -default 0
126		set cancel 1
127	    } else {
128		$w add -text [::msgcat::mc "Prev"] \
129		    -state disabled \
130		    -command [list [namespace current]::execute_window \
131				   $w $xlib $jid $node $sessionid prev \
132				   [list [namespace current]::next_result]]
133		$w add -text [::msgcat::mc "Next"] \
134		    -state disabled \
135		    -command [list [namespace current]::execute_window \
136				   $w $xlib $jid $node $sessionid next \
137				   [list [namespace current]::next_result]]
138		$w add -text [::msgcat::mc "Finish"] \
139		    -state disabled \
140		    -command [list [namespace current]::execute_window \
141				   $w $xlib $jid $node $sessionid complete \
142				   [list [namespace current]::complete_result]]
143		$w add -text [::msgcat::mc "Cancel"] \
144		    -command [list [namespace current]::cancel_window \
145				   $w $xlib $jid $node $sessionid]
146		set_default_button $w $actions $execute
147		set cancel 3
148
149	    }
150	}
151	completed {
152	    $w add -text [::msgcat::mc "Close"] \
153		-command [list [namespace current]::close_window $w]
154	    $w configure -default 0
155	    set cancel 0
156	}
157    }
158    # Can't configure -cancel option because of bug in BWidget
159    # $w configure -cancel $cancel
160    bind $w <Escape> [list $w.bbox invoke $cancel]
161    bind $f <Destroy> [list data::cleanup %W]
162
163    bindscroll $f $sf
164
165    #pack [Separator $w.sep] -side bottom -fill x  -pady 1m
166
167    pack $nf -side top -expand no -fill x -padx 2m -pady 0m -in [$w getframe]
168    pack $sw -side top -expand yes -fill both -padx 2m -pady 2m -in [$w getframe]
169
170    update idletasks
171    $nf configure -width [expr {[winfo reqwidth $f] + [winfo pixels $f 1c]}]
172
173    if {$focus != ""} {
174	$w draw $focus
175    } else {
176	$w draw
177    }
178
179    return $w
180}
181
182##########################################################################
183
184proc xcommands::execute_window {w xlib jid node sessionid action cmd} {
185    # Send requested data and wait for result
186
187    set vars [list sessionid $sessionid action $action]
188    if {$node != ""} {
189	lappend vars node $node
190    }
191
192    set f [$w.fields getframe]
193
194    ::xmpp::sendIQ $xlib set \
195	-query [::xmpp::xml::create command \
196			-xmlns $::NS(commands) \
197			-attrs $vars \
198			-subelement [::xmpp::data::submitForm [data::get_fields $f]]] \
199	-command [list $cmd $w $xlib $jid $node $sessionid] \
200	-to $jid
201}
202
203##########################################################################
204
205proc xcommands::pack_note {fr type note} {
206    set mf $fr.msg
207    if {[winfo exists $mf]} {
208	destroy $mf
209    }
210
211    if {$note == ""} return
212
213    switch -- $type {
214	warn {
215	    set msg [::msgcat::mc "Warning:"]
216	}
217	error {
218	    set msg [::msgcat::mc "Error:"]
219	}
220	default {
221	    set msg [::msgcat::mc "Info:"]
222	}
223    }
224    message $mf -text "$msg $note" -aspect 50000 -width 0
225    pack $mf
226}
227
228##########################################################################
229
230proc xcommands::set_default_button {bbox actions execute} {
231    set default -1
232    foreach action $actions {
233	switch -- $action {
234	    prev {
235		$bbox itemconfigure 0 -state normal
236		if {$default == -1} {
237		    set default 0
238		}
239	    }
240	    next {
241		$bbox itemconfigure 1 -state normal
242		set default 1
243	    }
244	    complete {
245		$bbox itemconfigure 2 -state normal
246		if {$default == -1 || $default == 0} {
247		    set default 2
248		}
249	    }
250	}
251    }
252    if {$default != -1} {
253	$bbox configure -default $default
254    } else {
255	$bbox itemconfigure 1 -state normal
256	$bbox configure -default 1
257    }
258    switch -- $execute {
259	prev {
260	    $bbox itemconfigure 0 -state normal
261	    $bbox configure -default 0
262	}
263	next {
264	    $bbox itemconfigure 1 -state normal
265	    $bbox configure -default 1
266	}
267	complete {
268	    $bbox itemconfigure 2 -state normal
269	    $bbox configure -default 2
270	}
271    }
272}
273
274##########################################################################
275
276proc xcommands::next_result {w xlib jid node sessionid res child} {
277    variable winid
278
279    set f [$w.fields getframe]
280
281    foreach cw [winfo children $f] {
282	destroy $cw
283    }
284
285    data::cleanup $f
286
287    if {[string equal $res error]} {
288	incr winid
289	set w .xcommands_err$winid
290
291	if {[winfo exists $w]} {
292	    destroy $w
293	}
294
295	MessageDlg $w -aspect 50000 -icon error \
296	    -message [format \
297			  [::msgcat::mc "Error executing command: %s"] \
298			  [error_to_string $child]] \
299	    -type user -buttons ok -default 0 -cancel 0
300	return
301    }
302
303    # TODO
304    ::xmpp::xml::split $child tag xmlns attrs cdata subels
305
306    set node [::xmpp::xml::getAttr $attrs node]
307    set sessionid [::xmpp::xml::getAttr $attrs sessionid]
308    set status [::xmpp::xml::getAttr $attrs status]
309
310    destroy $w
311    draw_window $xlib $jid $node $sessionid $status $subels
312}
313
314##########################################################################
315
316proc xcommands::complete_result {w xlib jid node sessionid res child} {
317    variable winid
318
319    if {[string equal $res err]} {
320	incr winid
321	set w .xcommands_err$winid
322
323	if {[winfo exists $w]} {
324	    destroy $w
325	}
326
327	MessageDlg $w -aspect 50000 -icon error \
328	    -message [format \
329			  [::msgcat::mc "Error completing command: %s"] \
330			  [error_to_string $child]] \
331	    -type user -buttons ok -default 0 -cancel 0
332	return
333    }
334
335    # TODO
336    ::xmpp::xml::split $child tag xmlns attrs cdata subels
337
338    set node [::xmpp::xml::getAttr $attrs node]
339    set sessionid [::xmpp::xml::getAttr $attrs sessionid]
340    set status [::xmpp::xml::getAttr $attrs status]
341
342    switch -- $status {
343	executing -
344	completed { }
345	canceled -
346	default { return }
347    }
348
349    lassign [find_note $subels] type note
350    lassign [find_actions $subels] actions execute
351
352    # Only jabber:x:data payloads are supported
353    lassign [::xmpp::data::findForm $subels] type form
354    set xdata [::xmpp::data::parseForm $form]
355
356    set f [$w.fields getframe]
357
358    foreach cw [winfo children $f] {
359	destroy $cw
360    }
361
362    data::cleanup $f
363
364    set nf $w.note
365
366    pack_note $nf $type $note
367    set focus [data::fill_fields_x $f $xdata]
368
369    destroy $w
370    draw_window $xlib $jid $node $sessionid $status $subels
371}
372
373##########################################################################
374
375proc xcommands::cancel_window {w xlib jid node sessionid} {
376    # Send cancelling stanza and ignore reply or error
377
378    set vars [list sessionid $sessionid action cancel]
379    if {$node != ""} {
380	lappend vars node $node
381    }
382
383    ::xmpp::sendIQ $xlib set \
384	-query [::xmpp::xml::create command \
385			-xmlns $::NS(commands) \
386			-attrs $vars] \
387	-command [namespace code cancel_result] \
388	-to $jid
389
390    close_window $w
391}
392
393proc xcommands::cancel_result {args} {}
394
395##########################################################################
396
397proc xcommands::close_window {w} {
398    set f [$w.fields getframe]
399    data::cleanup $f
400
401    destroy $w
402}
403
404##########################################################################
405
406proc xcommands::find_actions {xmldata} {
407    set actions {}
408    set execute next
409    foreach child $xmldata {
410	::xmpp::xml::split $child tag xmlns attrs cdata subels
411	if {$tag == "actions"} {
412	    if {[::xmpp::xml::isAttr $attrs execute]} {
413		set execute [::xmpp::xml::getAttr $attrs execute]
414	    }
415	    foreach subel $subels {
416		::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
417		switch -- $stag {
418		    prev -
419		    next -
420		    complete { lappend actions $stag }
421		}
422	    }
423	    if {[lsearch -exact $actions $execute] < 0} {
424		set execute next
425	    }
426	}
427    }
428    return [list $actions $execute]
429}
430
431##########################################################################
432
433proc xcommands::find_note {xmldata} {
434    set note ""
435    set type info
436    foreach child $xmldata {
437	::xmpp::xml::split $child tag xmlns attrs cdata subels
438	if {$tag == "note"} {
439	    set note [string trim $cdata]
440	    set type [::xmpp::xml::getAttr $attrs type]
441	    switch -- $type {
442		info -
443		warn -
444		error { }
445		default { set type info }
446	    }
447	}
448    }
449    return [list $type $note]
450}
451
452##########################################################################
453
454proc xcommands::register_namespace {} {
455    disco::browser::register_feature_handler $::NS(commands) \
456	[namespace current]::execute -node 1 \
457	-desc [list automation [::msgcat::mc "Execute command"]]
458    disco::register_featured_node $::NS(commands) $::NS(commands) \
459				  [::msgcat::mc "Commands"]
460}
461
462hook::add postload_hook [namespace current]::xcommands::register_namespace
463
464##########################################################################
465
466proc xcommands::add_menu_item {m xlib jid} {
467    set mm [menu $m.commands -tearoff 0]
468
469    $m add cascade -label [::msgcat::mc "Commands"] \
470		   -menu $mm \
471		   -state disabled
472
473    disco::request_items $xlib $jid \
474	-node $::NS(commands) \
475	-cache yes \
476	-command [namespace code [list recv_commands $m $xlib $jid $mm]]
477}
478
479proc xcommands::recv_commands {m xlib jid mm status items} {
480    if {![string equal $status ok]} return
481    if {![winfo exists $m] || ![winfo exists $mm]} return
482
483    set q 0
484    foreach item $items {
485	set jid [::xmpp::xml::getAttr $item jid]
486	if {[string equal $jid ""]} continue
487
488	set node [::xmpp::xml::getAttr $item node]
489	if {[string equal $node ""]} continue
490
491	set name [::xmpp::xml::getAttr $item name]
492	if {[string equal $name ""]} {
493	    set name $node
494	}
495
496	$mm add command -label $name \
497			-command [namespace code [list execute $xlib $jid $node]]
498	set q 1
499    }
500
501    if {$q} {
502	$m entryconfigure [::msgcat::mc "Commands"] -state normal
503    }
504}
505
506hook::add chat_create_user_menu_hook [namespace current]::xcommands::add_menu_item 43.5
507hook::add chat_create_conference_menu_hook [namespace current]::xcommands::add_menu_item 43.5
508hook::add roster_create_groupchat_user_menu_hook [namespace current]::xcommands::add_menu_item 43.5
509hook::add roster_conference_popup_menu_hook [namespace current]::xcommands::add_menu_item 43.5
510hook::add roster_service_popup_menu_hook [namespace current]::xcommands::add_menu_item 43.5
511hook::add roster_jid_popup_menu_hook [namespace current]::xcommands::add_menu_item 43.5
512hook::add message_dialog_menu_hook [namespace current]::xcommands::add_menu_item 43.5
513hook::add search_popup_menu_hook [namespace current]::xcommands::add_menu_item 43.5
514
515