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