dbuslua.tk 3.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485
  1. #!/usr/bin/env wish
  2. # Example Tcl/Tk script for use with the Cool VL Viewer D-Bus interface for Lua
  3. # (c)2018-2021 Henri Beauchamp. This script is provided under the GPL license.
  4. #
  5. # Note: either the dbus-tcl package or the dbus-send command must be installed
  6. # on the system for this script to work. The viewer must be running (with a
  7. # user logged in) so that its D-Bus server runs and accepts commands. It also
  8. # must be configured to accept Lua commands via D-Bus (via the menu option
  9. # "Advanced" -> "Lua scripting" -> "Accept Lua commands from D-Bus").
  10. if {$tcl_version < 8.4} {
  11. tk_messageBox -type ok -icon error \
  12. -message "This program needs Tcl/Tk v8.4 or newer.\nThe current version is: $tcl_version"
  13. exit
  14. }
  15. set DbusDestination "com.secondlife.ViewerAppAPIService"
  16. set DbusPath "/com/secondlife/ViewerAppAPI"
  17. set DbusInterface "com.secondlife.ViewerAppAPI"
  18. set DbusMethod "LuaExec"
  19. set dbuscmd ""
  20. if {[catch {package require dbus} result]} {
  21. set dbuscmd "dbus-send"
  22. }
  23. wm title . "Cool VL Viewer Lua D-Bus interface"
  24. # Attempt to set an application icon for this Tk window. Note: PNG format only
  25. # supported in Tk v8.6 and newer.
  26. if {$tcl_version >= 8.6} {
  27. catch {
  28. set script_path [file dirname [file normalize [info script]]]
  29. set icon_file [file join $script_path "cvlv_icon.png"]
  30. image create photo .i1 -format png -file $icon_file
  31. wm iconphoto . -default .i1
  32. #wm withdraw .
  33. #wm state . normal
  34. }
  35. }
  36. proc execute {} {
  37. global dbuscmd DbusDestination DbusPath DbusInterface DbusMethod
  38. set command [.input.text get 1.0 end]
  39. if {$dbuscmd eq ""} {
  40. set dbus_id [dbus connect session]
  41. catch {dbus call $dbus_id -autostart 0 -dest $DbusDestination -signature s $DbusPath $DbusInterface $DbusMethod $command} result
  42. dbus close $dbus_id
  43. } elseif {![catch {exec $dbuscmd --session --type=method_call --print-reply --dest=$DbusDestination $DbusPath $DbusInterface.$DbusMethod string:$command} result]} {
  44. set idx [string first "string \"" $result 0]
  45. if {$idx > 0} {
  46. set result [string range $result $idx+8 end-1]
  47. }
  48. }
  49. .output.text configure -state normal
  50. .output.text delete 1.0 end
  51. .output.text insert 1.0 $result
  52. .output.text configure -state disabled
  53. }
  54. frame .input -borderwidth 2
  55. frame .output -borderwidth 2
  56. frame .buttons -borderwidth 2
  57. pack .input .output .buttons -side top -padx 4 -pady 4
  58. label .input.label -text "Lua\ncommand:" -width 8
  59. label .input.space -text " "
  60. text .input.text -width 80 -height 6 -wrap word -relief sunken -yscrollcommand {.input.scrollbar set}
  61. scrollbar .input.scrollbar -command {.input.text yview}
  62. pack .input.label .input.space .input.text .input.scrollbar -side left -fill y
  63. label .output.label -text "Result:" -width 8
  64. label .output.space -text " "
  65. text .output.text -width 80 -height 6 -wrap word -relief sunken -yscrollcommand {.output.scrollbar set} -state disabled
  66. scrollbar .output.scrollbar -command {.output.text yview}
  67. pack .output.label .output.space .output.text .output.scrollbar -side left -fill y
  68. button .buttons.exec -text "Execute" -command {execute}
  69. button .buttons.quit -text "Quit" -command {exit}
  70. label .buttons.space -text " "
  71. pack .buttons.exec .buttons.space .buttons.quit -side left
  72. # Example default command:
  73. #.input.text insert 1.0 {print("Hello world !")}