You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2531 lines
65 KiB
2531 lines
65 KiB
/*
|
|
* tkx11vnc.h: generated by 'tkx11vnc -spit'
|
|
* Abandon all hope, ye who enter here...
|
|
* ...edit tkx11vnc instead.
|
|
*/
|
|
char gui_code[] =
|
|
"#!/bin/sh\n"
|
|
"# the next line restarts using wish. \\\n"
|
|
"exec wish \"$0\" \"$@\"\n"
|
|
"catch {rename send {}}\n"
|
|
"#\n"
|
|
"# Copyright (c) 2004 Karl J. Runge <runge@karlrunge.com>\n"
|
|
"# All rights reserved.\n"
|
|
"#\n"
|
|
"# This is free software; you can redistribute it and/or modify\n"
|
|
"# it under the terms of the GNU General Public License as published by\n"
|
|
"# the Free Software Foundation; either version 2 of the License, or\n"
|
|
"# (at your option) any later version.\n"
|
|
"#\n"
|
|
"# This software is distributed in the hope that it will be useful,\n"
|
|
"# but WITHOUT ANY WARRANTY; without even the implied warranty of\n"
|
|
"# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n"
|
|
"# GNU General Public License for more details.\n"
|
|
"#\n"
|
|
"# You should have received a copy of the GNU General Public License\n"
|
|
"# along with this software; if not, write to the Free Software\n"
|
|
"# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,\n"
|
|
"# USA.\n"
|
|
"\n"
|
|
"#\n"
|
|
"# tkx11vnc v0.1\n"
|
|
"# This is a simple frontend to x11vnc. It uses the remote control\n"
|
|
"# and query features (-remote/-query aka -R/-Q) to interact with it. \n"
|
|
"# It is just a quick-n-dirty hack (it parses -help output, etc), but\n"
|
|
"# it could be of use playing with or learning about the (way too) many\n"
|
|
"# parameters x11vnc has.\n"
|
|
"# \n"
|
|
"# It can be used to interact with a running x11vnc (see the x11vnc\n"
|
|
"# -gui option), or to set the parameters and then start up x11vnc. \n"
|
|
"# \n"
|
|
"\n"
|
|
"#\n"
|
|
"# Below is a simple picture of how the gui should be laid out and how\n"
|
|
"# the menus should be organized. Most menu items correspond to remote\n"
|
|
"# control commands. A trailing \":\" after the item name means it is a string\n"
|
|
"# to be set rather than a boolean that can be toggled (e.g. the entry\n"
|
|
"# box must be used).\n"
|
|
"#\n"
|
|
"# Some tweak options may be set in the prefix \"=\" string.\n"
|
|
"# A means it is an \"Action\" (not a true variable)\n"
|
|
"# R means it is an action only valid in remote mode.\n"
|
|
"# S means it is an action only valid in startup mode.\n"
|
|
"# Q means it is an action worth querying after running.\n"
|
|
"# D means it is a good idea to delay a little before querying \n"
|
|
"# (i.e. perhaps it causes x11vnc to do a lot of work, new fb)\n"
|
|
"# No longer used, -sync is used instead.\n"
|
|
"# P means the string can be +/- appended/deleted (string may not\n"
|
|
"# be the same after the remote command)\n"
|
|
"# G means gui internal item\n"
|
|
"# F means can be set via file browse\n"
|
|
"# -C:val1,... means it will be a checkbox (radio button)\n"
|
|
"# the \"-\" means no other options follow\n"
|
|
"# 0 means to skip the item.\n"
|
|
"# -- means add a separator\n"
|
|
"#\n"
|
|
"proc set_template {} {\n"
|
|
" global template\n"
|
|
" set template \"\n"
|
|
"Row: Actions Clients Permissions Keyboard Pointer Help\n"
|
|
"Row: Displays Screen Tuning Debugging Misc\n"
|
|
"\n"
|
|
"Actions\n"
|
|
" =SA start\n"
|
|
" =RA stop\n"
|
|
" =GA attach\n"
|
|
" =RA detach\n"
|
|
" --\n"
|
|
" =RA ping\n"
|
|
" =RA update-all\n"
|
|
" =GA clear-all\n"
|
|
" --\n"
|
|
" =RA stop+quit \n"
|
|
" =GA Quit \n"
|
|
"\n"
|
|
"Help\n"
|
|
" =GA gui\n"
|
|
" =GA all\n"
|
|
"\n"
|
|
"Clients\n"
|
|
" =RQA current:\n"
|
|
" =F connect:\n"
|
|
" =RQA disconnect:\n"
|
|
" --\n"
|
|
" accept:\n"
|
|
" gone:\n"
|
|
" vncconnect\n"
|
|
" --\n"
|
|
" =F httpdir:\n"
|
|
" httpport:\n"
|
|
" enablehttpproxy\n"
|
|
"\n"
|
|
"Displays\n"
|
|
" display:\n"
|
|
" =F auth:\n"
|
|
" desktop:\n"
|
|
" rfbport:\n"
|
|
" =0 gui:\n"
|
|
"\n"
|
|
"Screen\n"
|
|
" =DRA refresh\n"
|
|
" =DRA reset\n"
|
|
" =DRA blacken\n"
|
|
" --\n"
|
|
" =D id:\n"
|
|
" =D sid:\n"
|
|
" =D scale:\n"
|
|
" --\n"
|
|
" =D overlay\n"
|
|
" overlay_nocursor\n"
|
|
" --\n"
|
|
" =D visual:\n"
|
|
" flashcmap\n"
|
|
" notruecolor\n"
|
|
" --\n"
|
|
" =DP blackout:\n"
|
|
" =D xinerama\n"
|
|
" --\n"
|
|
" = xrandr\n"
|
|
" =-C:resize,newfbsize,exit xrandr_mode:\n"
|
|
" padgeom:\n"
|
|
"\n"
|
|
"Keyboard\n"
|
|
" norepeat\n"
|
|
" add_keysyms\n"
|
|
" modtweak\n"
|
|
" xkb\n"
|
|
" skip_keycodes:\n"
|
|
" --\n"
|
|
" =FP remap:\n"
|
|
" --\n"
|
|
" clear_mods\n"
|
|
" clear_keys\n"
|
|
"\n"
|
|
"Pointer\n"
|
|
" =-C:none,arrow,X,some,most cursor:\n"
|
|
" noxfixes\n"
|
|
" --\n"
|
|
" cursorpos\n"
|
|
" nocursorshape\n"
|
|
" --\n"
|
|
" buttonmap:\n"
|
|
" --\n"
|
|
" xwarppointer\n"
|
|
"\n"
|
|
"Misc\n"
|
|
" =F rc:\n"
|
|
" norc\n"
|
|
" --\n"
|
|
" nofb\n"
|
|
" --\n"
|
|
" nobell\n"
|
|
" nosel\n"
|
|
" noprimary\n"
|
|
" --\n"
|
|
" bg\n"
|
|
" =-C:ignore,exit sigpipe:\n"
|
|
" =0 inetd\n"
|
|
" --\n"
|
|
" =RA remote-cmd:\n"
|
|
" =GA all-settings\n"
|
|
"\n"
|
|
"Debugging\n"
|
|
" debug_pointer\n"
|
|
" debug_keyboard\n"
|
|
" =F logfile:\n"
|
|
" quiet\n"
|
|
" --\n"
|
|
" =GA show-start-cmd\n"
|
|
" =G debug_gui\n"
|
|
"\n"
|
|
"Permissions\n"
|
|
" =RQA lock\n"
|
|
" =RQA unlock\n"
|
|
" =SQA deny_all\n"
|
|
" --\n"
|
|
" =FP allow:\n"
|
|
" localhost\n"
|
|
" =RA allowonce:\n"
|
|
" --\n"
|
|
" viewonly\n"
|
|
" shared\n"
|
|
" forever\n"
|
|
" --\n"
|
|
" =RA noremote\n"
|
|
" --\n"
|
|
" alwaysshared\n"
|
|
" nevershared\n"
|
|
" dontdisconnect\n"
|
|
" --\n"
|
|
" viewpasswd:\n"
|
|
" =F passwdfile:\n"
|
|
" =0 storepasswd\n"
|
|
" =F rfbauth:\n"
|
|
" passwd:\n"
|
|
" --\n"
|
|
" safer\n"
|
|
" unsafe\n"
|
|
"\n"
|
|
"Tuning\n"
|
|
" =-C:1,2,3,4 pointer_mode:\n"
|
|
" input_skip:\n"
|
|
" nodragging\n"
|
|
" --\n"
|
|
" =D noshm\n"
|
|
" flipbyteorder\n"
|
|
" onetile\n"
|
|
" --\n"
|
|
" wait:\n"
|
|
" defer:\n"
|
|
" nap\n"
|
|
" screen_blank:\n"
|
|
" --\n"
|
|
" fs:\n"
|
|
" gaps:\n"
|
|
" grow:\n"
|
|
" fuzz:\n"
|
|
" --\n"
|
|
" threads\n"
|
|
" rfbwait:\n"
|
|
" --\n"
|
|
" progressive:\n"
|
|
"\"\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc set_internal_help {} {\n"
|
|
" global helptext helpall\n"
|
|
"\n"
|
|
" # set some internal item help here:\n"
|
|
" set helptext(start) \"\n"
|
|
"Launch x11vnc with the settings you have prescribed in the gui.\n"
|
|
"The x11vnc process is started in an xterm window so you can see the\n"
|
|
"output, kill it, etc.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(show-start-cmd) \"\n"
|
|
"Displays in the text area what the x11vnc start command (i.e. the command\n"
|
|
"run by \\\"Actions -> start\\\") looks like for the current values of the\n"
|
|
"settings. This can be done even in the attached state. Intended for\n"
|
|
"debugging the gui. The help item for \\\"Actions -> start\\\" gives the\n"
|
|
"same info.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(debug_gui) \"\n"
|
|
"Set debug_gui to get more output printed in the text area.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(detach) \"\n"
|
|
"No longer be associated with the x11vnc server. Switch to non-connected\n"
|
|
"state.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(attach) \"\n"
|
|
"Attach to the x11vnc server, if possible. Switches to connected state\n"
|
|
"if successful. To change or set the X display use \\\"Displays -> display\\\"\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(ping) \"\n"
|
|
"Check if x11vnc still responds to \\\"ping\\\" remote command.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(update-all) \"\n"
|
|
"Query the x11vnc server for the current values of all variables.\n"
|
|
"Populate the values into the gui's database.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(clear-all) \"\n"
|
|
"Forget any variable settings either entered in by you or retrieved\n"
|
|
"from a running x11vnc server. Basically sets everything to 0 or\n"
|
|
"the string (unset).\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(all-settings) \"\n"
|
|
"Displays the gui's database of all of the x11vnc server's current\n"
|
|
"settings. Use \\\"Actions -> update-all\\\" or \\\"Control+R\\\" to\n"
|
|
"refresh this list if it ever gets out of sync.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(remote-cmd) \"\n"
|
|
"Run a remote command (-R) or query (-Q) directly. Only a few\n"
|
|
"remote commands are not on a menu, but for those few you can\n"
|
|
"run the command directly this way. Just enter the command into\n"
|
|
"the Entry box when prompted. Use the prefix \\\"Q:\\\" to indicate\n"
|
|
"a -Q query. Examples: \\\"zero:20,20,100,100\\\", \\\"Q:ext_xfixes\\\" \n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(stop+quit) \"\n"
|
|
"Send the stop command to the x11vnc server, then terminate the tkx11vnc gui.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(Quit) \"\n"
|
|
"Terminate the tkx11vnc gui. Any x11vnc servers will be left running.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(current) \"\n"
|
|
"Shows a menu of currently connected VNC clients on the x11vnc server.\n"
|
|
"\n"
|
|
"Allows you to find more information about them or disconnect them.\n"
|
|
"You will be prompted to confirm any disconnections.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(xrandr_mode) \"\n"
|
|
"Set the -xrandr mode value.\n"
|
|
"\"\n"
|
|
"\n"
|
|
" set helptext(all) $helpall\n"
|
|
"\n"
|
|
" set helptext(gui) \"\n"
|
|
"tkx11vnc is a simple frontend to x11vnc. Nothing fancy, it merely\n"
|
|
"provides an interface to each of the many x11vnc command line options and\n"
|
|
"remote control commands. See \\\"Help -> all\\\" for much info about x11vnc.\n"
|
|
"\n"
|
|
"Most menu items have a (?) button one can click on to get more information\n"
|
|
"about the option or command. In most cases it will be text extracted\n"
|
|
"from that in \\\"Help -> all\\\".\n"
|
|
"\n"
|
|
"There are two states tkx11vnc can be in:\n"
|
|
"\n"
|
|
" 1) Available to control a running x11vnc process.\n"
|
|
" 2) Getting ready to start a x11vnc process.\n"
|
|
"\n"
|
|
"In state 1) the Menu items available in the menus are those that\n"
|
|
"correspond to the x11vnc \\\"remote control\\\" commands. See the -remote\n"
|
|
"entry under \\\"Help -> all\\\" for a complete list. Also available is\n"
|
|
"the \\\"Actions -> stop\\\" item to shut down the running x11vnc server,\n"
|
|
"thereby changing to state 2). One could also simply \\\"Actions -> detach\\\"\n"
|
|
"leaving the x11vnc server running. \\\"Actions -> attach\\\" would\n"
|
|
"reestablish the connection.\n"
|
|
"\n"
|
|
"In state 2) the Menu items available in the menus (Actions, Clients,\n"
|
|
"etc.) are those that correspond to command line options used in starting\n"
|
|
"an x11vnc process, and the \\\"Actions -> start\\\" item executes\n"
|
|
"x11vnc thereby changing to state 1). To see what x11vnc startup command\n"
|
|
"you have built so far, look at the (?) help for \\\"Actions -> start\\\"\n"
|
|
"and it will show you what the command looks like.\n"
|
|
"\n"
|
|
"There is much overlap between the menu items available in state 1)\n"
|
|
"and state 2), but it is worth keeping in mind it is not 100%.\n"
|
|
"For example, you cannot set passwords or password files in state 1).\n"
|
|
"\n"
|
|
"Also note that there may be *two* separate X displays involved, not just\n"
|
|
"one: 1) the X display x11vnc will be polling (and making available to\n"
|
|
"VNC viewers), and 2) the X display this GUI is intended to display on.\n"
|
|
"For example, one might use ssh to access the remote machine where the\n"
|
|
"GUI would display on :11 and x11vnc would poll display :0.\n"
|
|
"\n"
|
|
"\n"
|
|
"GUI components: \n"
|
|
"--- ----------\n"
|
|
"\n"
|
|
"At the top of the gui is a info text label where information will\n"
|
|
"be posted, e.g. when traversing menu items text indicating how to get\n"
|
|
"help on the item and its current value will be displayed.\n"
|
|
"\n"
|
|
"Below the info label is the area where the menu buttons, Actions,\n"
|
|
"Clients, etc., are presented. If a menu item has a checkbox,\n"
|
|
"it corresponds to a boolean on/off variable. Otherwise it is\n"
|
|
"either a string variable, or an action not associated with a\n"
|
|
"variable (for the most part).\n"
|
|
"\n"
|
|
"Below the menu button area is a text label indicating the current x11vnc\n"
|
|
"X display being polled and the corresponding VNC display name. Both\n"
|
|
"will be \\\"(*none*)\\\" when there is no connection established.\n"
|
|
"\n"
|
|
"Below the x11 and vnc displays text label is a text area there scrolling\n"
|
|
"information about actions being taken and commands being run is displayed.\n"
|
|
"To scroll use PageUp/PageDown or the arrow keys.\n"
|
|
"\n"
|
|
"At the bottom is an entry area. When one selects a menu item that\n"
|
|
"requires supplying a string value, the label will be set to the\n"
|
|
"parameter name and one types in the new value. Then one presses the\n"
|
|
"\\\"OK\\\" button or presses \\\"Enter\\\" to set the value. Or you can press\n"
|
|
"\\\"Skip\\\" or \\\"Escape\\\" to avoid changing the variable. Some variables\n"
|
|
"are boolean toggles (for example, \\\"Permissions -> viewonly\\\") or Radio\n"
|
|
"button selections. Selecting these menu items will not activate the\n"
|
|
"entry area but rather toggle the variable directly.\n"
|
|
"\n"
|
|
"Cascades: There is a bug not yet worked around for the cascade menus\n"
|
|
"where the (?) help button gets in the way. To get the mouse over to\n"
|
|
"the cascade menu click and release mouse to activate the cascade, then\n"
|
|
"you can click on its items. Dragging with a mouse button held down\n"
|
|
"will not work (sorry).\n"
|
|
"\n"
|
|
"Key Bindings:\n"
|
|
"\n"
|
|
" In the Text Area: Control-/ selects all of the text.\n"
|
|
" Anywhere: Control-d invokes \\\"Actions -> detach\\\"\n"
|
|
" Anywhere: Control-a invokes \\\"Actions -> attach\\\"\n"
|
|
" Anywhere: Control-p invokes \\\"Actions -> ping\\\"\n"
|
|
" Anywhere: Control-u and Control-r invoke \\\"Actions -> update-all\\\"\n"
|
|
"\n"
|
|
"\"\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc center_win {w} {\n"
|
|
" wm withdraw $w\n"
|
|
" set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2];\n"
|
|
" set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2];\n"
|
|
" wm geom $w +$x+$y\n"
|
|
" wm deiconify $w\n"
|
|
" update\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc textwidth {text} {\n"
|
|
" set min 0;\n"
|
|
" foreach line [split $text \"\\n\"] {\n"
|
|
" set n [string length $line]\n"
|
|
" if {$n > $min} {\n"
|
|
" set min $n\n"
|
|
" }\n"
|
|
" }\n"
|
|
" return $min\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc textheight {text} {\n"
|
|
" set count 0;\n"
|
|
" foreach line [split $text \"\\n\"] {\n"
|
|
" incr count\n"
|
|
" }\n"
|
|
" return $count\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc make_toplevel {w {title \"\"}} {\n"
|
|
" catch {destroy $w}\n"
|
|
" toplevel $w;\n"
|
|
" bind $w <Escape> \"destroy $w\"\n"
|
|
" if {$title != \"\"} {\n"
|
|
" wm title $w $title\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc textwin {name title text} {\n"
|
|
" global max_text_height max_text_width\n"
|
|
" global bfont\n"
|
|
"\n"
|
|
" set width [textwidth $text]\n"
|
|
" incr width\n"
|
|
" if {$width > $max_text_width} {\n"
|
|
" set width $max_text_width\n"
|
|
" }\n"
|
|
" set height [textheight $text]\n"
|
|
" if {$height > $max_text_height} {\n"
|
|
" set height $max_text_height\n"
|
|
" }\n"
|
|
"\n"
|
|
" set w \".text_$name\"\n"
|
|
" make_toplevel $w $title\n"
|
|
"\n"
|
|
" frame $w.f -bd 0;\n"
|
|
" pack $w.f -fill both -expand 1\n"
|
|
" text $w.f.t -width $width -height $height -setgrid 1 -bd 2 \\\n"
|
|
" -yscrollcommand \"$w.f.y set\" -relief ridge -font fixed;\n"
|
|
" scrollbar $w.f.y -orient v -relief sunken -command \"$w.f.t yview\";\n"
|
|
" button $w.f.b -text \"Dismiss\" -command \"destroy $w\" -font $bfont\n"
|
|
"\n"
|
|
" $w.f.t insert 1.0 $text;\n"
|
|
"\n"
|
|
" bind $w <Enter> \"focus $w.f.t\"\n"
|
|
"\n"
|
|
" wm withdraw $w\n"
|
|
" pack $w.f.b -side bottom -fill x \n"
|
|
" pack $w.f.y -side right -fill y;\n"
|
|
" pack $w.f.t -side top -fill both -expand 1;\n"
|
|
" update\n"
|
|
"\n"
|
|
" center_win $w\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc active_when_connected {item} {\n"
|
|
" global helpremote helptext\n"
|
|
"\n"
|
|
" if {[opt_match G $item]} {\n"
|
|
" return 1\n"
|
|
" } elseif {[is_action $item]} {\n"
|
|
" if {[opt_match R $item]} {\n"
|
|
" return 1\n"
|
|
" } else {\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
" } elseif {[info exists helpremote($item)]} {\n"
|
|
" return 1\n"
|
|
" } else {\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc active_when_starting {item} {\n"
|
|
" global helpremote helptext\n"
|
|
"\n"
|
|
" if {[opt_match G $item]} {\n"
|
|
" return 1\n"
|
|
" } elseif {[is_action $item]} {\n"
|
|
" if {[opt_match S $item]} {\n"
|
|
" return 1\n"
|
|
" } else {\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
" } elseif {[info exists helptext($item)]} {\n"
|
|
" return 1\n"
|
|
" } else {\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc help_win {item} {\n"
|
|
" global helptext helpremote\n"
|
|
" global query_ans query_aro;\n"
|
|
"\n"
|
|
" set ok 0\n"
|
|
" set text \"Help on $item:\\n\\n\"\n"
|
|
"\n"
|
|
" if {[is_gui_internal $item]} {\n"
|
|
" ;\n"
|
|
" } elseif {[is_action $item]} {\n"
|
|
" append text \" + Is a remote control Action (cannot be set).\\n\";\n"
|
|
" } elseif {[active_when_connected $item]} {\n"
|
|
" append text \" + Can be changed in a running x11vnc.\\n\";\n"
|
|
" } else {\n"
|
|
" append text \" - Cannot be changed in a running x11vnc.\\n\";\n"
|
|
" }\n"
|
|
" if {[is_gui_internal $item]} {\n"
|
|
" ;\n"
|
|
" } elseif {[active_when_starting $item]} {\n"
|
|
" append text \" + Can be set at x11vnc startup.\\n\";\n"
|
|
" } else {\n"
|
|
" append text \" - Cannot be set at x11vnc startup.\\n\";\n"
|
|
" }\n"
|
|
" append text \"\\n\"\n"
|
|
"\n"
|
|
" if {[info exists helptext($item)]} {\n"
|
|
" append text \"\\n\"\n"
|
|
" if {[is_gui_internal $item]} {\n"
|
|
" append text \"==== x11vnc help: ====\\n\";\n"
|
|
" } else {\n"
|
|
" append text \"==== x11vnc startup option help: ====\\n\";\n"
|
|
" }\n"
|
|
" append text \"\\n\"\n"
|
|
" append text $helptext($item)\n"
|
|
" append text \"\\n\"\n"
|
|
" set ok 1\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {[info exists helpremote($item)]} {\n"
|
|
" append text \"\\n\"\n"
|
|
" append text \"==== x11vnc remote control help: ====\\n\";\n"
|
|
" append text \"\\n\"\n"
|
|
" append text $helpremote($item)\n"
|
|
" set ok 1\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {$item == \"start\"} {\n"
|
|
" set str [get_start_x11vnc_txt]\n"
|
|
" append text $str\n"
|
|
" append_text \"$str\\n\"\n"
|
|
" append text \"\\nPossible \\$HOME/.x11vncrc settings for this command:\\n\\n\"\n"
|
|
" set rctxt [get_start_x11vnc_cmd 1]\n"
|
|
" append text \"$rctxt\\n\"\n"
|
|
" }\n"
|
|
"\n"
|
|
" regsub -all { } $item \" \" name\n"
|
|
"\n"
|
|
" if {$ok} {\n"
|
|
" textwin $name \"x11vnc help: $item\" \"$text\";\n"
|
|
" }\n"
|
|
" return $ok\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc parse_help {} {\n"
|
|
" global env x11vnc_prog;\n"
|
|
" global helpall helptext;\n"
|
|
"\n"
|
|
" set helppipe [open \"| $x11vnc_prog -help\" \"r\"];\n"
|
|
" if {$helppipe == \"\"} {\n"
|
|
" puts stderr \"failed to run $x11vnc_prog -help\";\n"
|
|
" exit 1;\n"
|
|
" }\n"
|
|
"\n"
|
|
" set sawopts 0;\n"
|
|
" set curropt \"\";\n"
|
|
" while {[gets $helppipe line] > -1} {\n"
|
|
" append helpall \"$line\\n\" \n"
|
|
"\n"
|
|
" # XXX\n"
|
|
" if {[regexp {^Options:} $line]} {\n"
|
|
" set sawopts 1;\n"
|
|
" continue;\n"
|
|
" }\n"
|
|
" # XXX\n"
|
|
" if {[regexp {^These options} $line]} {\n"
|
|
" continue;\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {! $sawopts} {\n"
|
|
" continue;\n"
|
|
" }\n"
|
|
" if {[regexp {^-([A-z_][A-z_]*)} $line match name]} {\n"
|
|
" set allnames($name) 1;\n"
|
|
" if {\"$curropt\" != \"no$name\" && \"no$curropt\" != \"$name\"} {\n"
|
|
" set curropt $name;\n"
|
|
" set helptext($curropt) \"$line\\n\";\n"
|
|
" } else {\n"
|
|
" append helptext($curropt) \"$line\\n\";\n"
|
|
" }\n"
|
|
" } elseif {$curropt != \"\"} {\n"
|
|
" append helptext($curropt) \"$line\\n\";\n"
|
|
" }\n"
|
|
" }\n"
|
|
" foreach name [array names allnames] {\n"
|
|
" if {[regexp {^no} $name]} {\n"
|
|
" regsub {^no} $name \"\" pair\n"
|
|
" } else {\n"
|
|
" set pair \"no$name\"\n"
|
|
" }\n"
|
|
" if {[info exists helptext($name)]} {\n"
|
|
" if ![info exists helptext($pair)] {\n"
|
|
" set helptext($pair) $helptext($name);\n"
|
|
" }\n"
|
|
" } elseif {[info exists helptext($pair)]} {\n"
|
|
" if ![info exists helptext($name)] {\n"
|
|
" set helptext($name) $helptext($pair);\n"
|
|
" }\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" set_internal_help\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc tweak_both {new old} {\n"
|
|
" tweak_help $new $old\n"
|
|
" tweak_remote_help $new $old\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc tweak_remote_help {new old} {\n"
|
|
" global helpremote\n"
|
|
" if ![info exists helpremote($new)] {\n"
|
|
" if {[info exists helpremote($old)]} {\n"
|
|
" set helpremote($new) $helpremote($old)\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc tweak_help {new old} {\n"
|
|
" global helptext\n"
|
|
" if ![info exists helptext($new)] {\n"
|
|
" if {[info exists helptext($old)]} {\n"
|
|
" set helptext($new) $helptext($old)\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc parse_remote_help {} {\n"
|
|
" global helpremote helptext help_indent remote_name;\n"
|
|
"\n"
|
|
" set sawopts 0;\n"
|
|
" set curropt \"\";\n"
|
|
" set possopts \"\";\n"
|
|
" set offset [expr $help_indent - 1];\n"
|
|
" foreach line [split $helptext(remote) \"\\n\"] {\n"
|
|
" \n"
|
|
" set line [string range $line $offset end];\n"
|
|
"\n"
|
|
" # XXX\n"
|
|
" if {[regexp {^The following -remote/-R commands} $line]} {\n"
|
|
" set sawopts 1;\n"
|
|
" continue;\n"
|
|
" }\n"
|
|
" # XXX\n"
|
|
" if {[regexp {^The vncconnect.*command} $line]} {\n"
|
|
" set sawopts 0;\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {! $sawopts} {\n"
|
|
" continue;\n"
|
|
" }\n"
|
|
" if {[regexp {^([A-z_][A-z_:]*)} $line match name]} {\n"
|
|
" regsub {:.*$} $name \"\" popt\n"
|
|
" lappend possopts $popt\n"
|
|
" if {\"$curropt\" != \"no$name\" && \"no$curropt\" != \"$name\"} {\n"
|
|
" set curropt $name;\n"
|
|
" regsub {:.*$} $curropt \"\" curropt\n"
|
|
" set remote_name($curropt) $name\n"
|
|
" set helpremote($curropt) \"$line\\n\";\n"
|
|
" } else {\n"
|
|
" append helpremote($curropt) \"$line\\n\";\n"
|
|
" }\n"
|
|
" } elseif {$curropt != \"\"} {\n"
|
|
" append helpremote($curropt) \"$line\\n\";\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" foreach popt $possopts {\n"
|
|
" if {[info exists helpremote($popt)]} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {[regexp {^no} $popt]} {\n"
|
|
" regsub {^no} $popt \"\" try\n"
|
|
" } else {\n"
|
|
" set try \"no$popt\"\n"
|
|
" }\n"
|
|
" if {[info exists helpremote($try)]} {\n"
|
|
" set helpremote($popt) $helpremote($try)\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc parse_query_help {} {\n"
|
|
" global query_ans query_aro query_ans_list query_aro_list helptext;\n"
|
|
"\n"
|
|
" set sawans 0;\n"
|
|
" set sawaro 0;\n"
|
|
" set ans_str \"\"\n"
|
|
" set aro_str \"\"\n"
|
|
"\n"
|
|
" foreach line [split $helptext(query) \"\\n\"] {\n"
|
|
"\n"
|
|
" if {! $sawans && [regexp {^ *ans=} $line]} {\n"
|
|
" set sawans 1\n"
|
|
" }\n"
|
|
" if {! $sawans} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {[regexp {^ *aro=} $line]} {\n"
|
|
" set sawaro 1\n"
|
|
" }\n"
|
|
" if {$sawaro && [regexp {^[ ]*$} $line]} {\n"
|
|
" set sawans 0\n"
|
|
" break\n"
|
|
" }\n"
|
|
"\n"
|
|
" regsub {ans=} $line \"\" line\n"
|
|
" regsub {aro=} $line \"\" line\n"
|
|
" set line [string trim $line]\n"
|
|
"\n"
|
|
" if {$sawaro} {\n"
|
|
" set aro_str \"$aro_str $line\"\n"
|
|
" } else {\n"
|
|
" set ans_str \"$ans_str $line\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" regsub -all { *} $ans_str \" \" ans_str\n"
|
|
" regsub -all { *} $aro_str \" \" aro_str\n"
|
|
"\n"
|
|
" set ans_str [string trim $ans_str]\n"
|
|
" set aro_str [string trim $aro_str]\n"
|
|
" set query_ans_list [split $ans_str]\n"
|
|
" set query_aro_list [split $aro_str]\n"
|
|
"\n"
|
|
" foreach item $query_ans_list {\n"
|
|
" if {[regexp {^[ ]*$} $item]} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" set query_ans($item) 1\n"
|
|
" }\n"
|
|
" foreach item $query_aro_list {\n"
|
|
" if {[regexp {^[ ]*$} $item]} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" set query_aro($item) 1\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc in_debug_mode {} {\n"
|
|
" global menu_var\n"
|
|
" if {![info exists menu_var(debug_gui)]} {\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
" return $menu_var(debug_gui)\n"
|
|
"}\n"
|
|
"\n"
|
|
"# Menubar utilities:\n"
|
|
"proc menus_state {state} {\n"
|
|
" global menu_b\n"
|
|
"\n"
|
|
" foreach case [array names menu_b] {\n"
|
|
" set menu_button $menu_b($case)\n"
|
|
" $menu_button configure -state $state\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc menus_enable {} {\n"
|
|
" global menus_disabled\n"
|
|
"\n"
|
|
" menus_state \"normal\"\n"
|
|
" set menus_disabled 0\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc menus_disable {} {\n"
|
|
" global menus_disabled\n"
|
|
"\n"
|
|
" set menus_disabled 1\n"
|
|
" menus_state \"disabled\"\n"
|
|
"}\n"
|
|
"\n"
|
|
"# Entry box utilities:\n"
|
|
"proc entry_state {x state} {\n"
|
|
" global entry_box entry_label entry_ok entry_help entry_skip entry_browse\n"
|
|
" if {$x == \"all\"} {\n"
|
|
" $entry_label configure -state $state\n"
|
|
" $entry_box configure -state $state\n"
|
|
" $entry_ok configure -state $state\n"
|
|
" $entry_skip configure -state $state\n"
|
|
" $entry_help configure -state $state\n"
|
|
" $entry_browse configure -state $state\n"
|
|
" } elseif {$x == \"label\"} {\n"
|
|
" $entry_label configure -state $state\n"
|
|
" } elseif {$x == \"box\"} {\n"
|
|
" $entry_box configure -state $state\n"
|
|
" } elseif {$x == \"ok\"} {\n"
|
|
" $entry_ok configure -state $state\n"
|
|
" } elseif {$x == \"skip\"} {\n"
|
|
" $entry_skip configure -state $state\n"
|
|
" } elseif {$x == \"help\"} {\n"
|
|
" $entry_help configure -state $state\n"
|
|
" } elseif {$x == \"browse\"} {\n"
|
|
" $entry_browse configure -state $state\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc entry_enable {{x \"all\"}} {\n"
|
|
" entry_state $x normal\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc entry_disable {{x \"all\"}} {\n"
|
|
" entry_state $x disabled\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc entry_browse_button {{show 1}} {\n"
|
|
" global entry_browse\n"
|
|
" if {$show} {\n"
|
|
" pack $entry_browse -side left\n"
|
|
" } else {\n"
|
|
" pack forget $entry_browse\n"
|
|
" }\n"
|
|
"}\n"
|
|
"proc entry_focus {} {\n"
|
|
" global entry_box\n"
|
|
" focus $entry_box\n"
|
|
"}\n"
|
|
"proc entry_select {} {\n"
|
|
" global entry_box\n"
|
|
" $entry_box selection range 0 end\n"
|
|
"}\n"
|
|
"proc entry_get {} {\n"
|
|
" global entry_box\n"
|
|
" return [$entry_box get]\n"
|
|
"}\n"
|
|
"proc entry_insert {str} {\n"
|
|
" global entry_box\n"
|
|
" entry_delete\n"
|
|
" $entry_box insert end $str\n"
|
|
" $entry_box icursor end\n"
|
|
"}\n"
|
|
"proc entry_delete {} {\n"
|
|
" global entry_box\n"
|
|
" $entry_box delete 0 end\n"
|
|
"}\n"
|
|
"\n"
|
|
"\n"
|
|
"# Utilities for remote control and updating vars.\n"
|
|
"\n"
|
|
"proc push_new_value0 {item name new {query 1}} {\n"
|
|
" # old way w/o -sync\n"
|
|
" global menu_var always_update remote_output query_output\n"
|
|
" global delay_sleep extra_sleep extra_sleep_split\n"
|
|
"\n"
|
|
" set debug [in_debug_mode]\n"
|
|
" set do_query_all 0\n"
|
|
" set getout 0\n"
|
|
"\n"
|
|
" if {$item == \"remote-cmd\"} {\n"
|
|
" # kludge for arbitrary remote command:\n"
|
|
" if {[regexp {^Q:} $new]} {\n"
|
|
" # extra kludge for Q:var to mean -Q var\n"
|
|
" regsub {^Q:} $new \"\" new\n"
|
|
" set qonly 1\n"
|
|
" } else {\n"
|
|
" set qonly 0\n"
|
|
" }\n"
|
|
" # need to extract item from new:\n"
|
|
" set qtmp $new\n"
|
|
" regsub {:.*$} $qtmp \"\" qtmp\n"
|
|
" if {! $qonly} {\n"
|
|
" set rargs [list \"-R\" \"$new\"]\n"
|
|
" set qargs [list \"-Q\" \"$qtmp\"]\n"
|
|
" set getout 1\n"
|
|
" } else {\n"
|
|
" set rargs [list \"-Q\" \"$qtmp\"]\n"
|
|
" set qargs [list \"-Q\" \"$qtmp\"]\n"
|
|
" }\n"
|
|
"\n"
|
|
" } elseif {[value_is_string $item]} {\n"
|
|
" set rargs [list \"-R\" \"$name:$new\"]\n"
|
|
" set qargs [list \"-Q\" \"$name\"]\n"
|
|
" } else {\n"
|
|
" set rargs [list \"-R\" \"$name\"]\n"
|
|
" set qargs [list \"-Q\" \"$name\"]\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {!$debug} {\n"
|
|
" append_text \"x11vnc $rargs ...\"\n"
|
|
" }\n"
|
|
" set remote_output [run_remote_cmd $rargs]\n"
|
|
"\n"
|
|
" if {[lindex $rargs 0] == \"-Q\"} {\n"
|
|
" append_text \"\\t$remote_output\"\n"
|
|
" set getout 1\n"
|
|
" } elseif {! $query && ! $always_update} {\n"
|
|
" set getout 1\n"
|
|
" } elseif {$item == \"noremote\"} {\n"
|
|
" set getout 1\n"
|
|
" } elseif {[is_action $item] && ![opt_match Q $item] && $rargs != \"\"} {\n"
|
|
" set getout 1\n"
|
|
" } elseif {[regexp {^(sid|id)$} $item] && ![regexp {^0x} $new]} {\n"
|
|
" set getout 1\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {$getout} {\n"
|
|
" append_text \"\\n\"\n"
|
|
" return\n"
|
|
" }\n"
|
|
"\n"
|
|
" stop_watch on\n"
|
|
" after $delay_sleep\n"
|
|
" if {[opt_match D $item]} {\n"
|
|
" set s [expr $extra_sleep/$extra_sleep_split] \n"
|
|
" append_text \" \"\n"
|
|
" for {set i 0} {$i<$extra_sleep_split} {incr i} {\n"
|
|
" after $s\n"
|
|
" append_text \".\"\n"
|
|
" update\n"
|
|
" }\n"
|
|
" }\n"
|
|
" stop_watch off\n"
|
|
"\n"
|
|
" if {!$debug} {\n"
|
|
" append_text \", -Q ...\"\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {$item == \"disconnect\"} {\n"
|
|
" set new \"N/A\"\n"
|
|
" set do_query_all 1\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {$always_update || $do_query_all} {\n"
|
|
" set query [query_all 1]\n"
|
|
" } else {\n"
|
|
" set query [run_remote_cmd $qargs]\n"
|
|
" }\n"
|
|
" set query_output $query\n"
|
|
"\n"
|
|
" if {![see_if_ok $query $item \"$name:$new\"]} {\n"
|
|
" # failed\n"
|
|
" if {[regexp {^a..=} $query]} {\n"
|
|
" # but some result came back\n"
|
|
" if {! $always_update} {\n"
|
|
" # synchronize everything\n"
|
|
" set query_output [query_all 1]\n"
|
|
" }\n"
|
|
" } else {\n"
|
|
" # server may be dead\n"
|
|
" if {$item != \"ping\" && $item != \"attach\"} {\n"
|
|
" try_connect\n"
|
|
" }\n"
|
|
" }\n"
|
|
" } else {\n"
|
|
" # succeeded\n"
|
|
" if {! $always_update} {\n"
|
|
" # synchronize this variable\n"
|
|
" update_menu_vars $query\n"
|
|
" } else {\n"
|
|
" # already done in query_all\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc push_new_value {item name new {query 1}} {\n"
|
|
" global menu_var always_update remote_output query_output\n"
|
|
" global delay_sleep extra_sleep extra_sleep_split\n"
|
|
" global query_result_list\n"
|
|
"\n"
|
|
" set debug [in_debug_mode]\n"
|
|
"\n"
|
|
" set getout 0\n"
|
|
" set print_getout 0;\n"
|
|
"\n"
|
|
" set do_query_all 0\n"
|
|
"\n"
|
|
" set newnew \"\"\n"
|
|
" if {$item == \"disconnect\"} {\n"
|
|
" set newnew \"N/A\"\n"
|
|
" set do_query_all 1\n"
|
|
" } elseif {$always_update} {\n"
|
|
" set do_query_all 1\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {$item == \"remote-cmd\"} {\n"
|
|
" # kludge for arbitrary remote command:\n"
|
|
" if {[regexp {^Q:} $new]} {\n"
|
|
" # extra kludge for Q:var to mean -Q var\n"
|
|
" regsub {^Q:} $new \"\" new\n"
|
|
" set qonly 1\n"
|
|
" } else {\n"
|
|
" set qonly 0\n"
|
|
" }\n"
|
|
" # need to extract item from new:\n"
|
|
" set qtmp $new\n"
|
|
" regsub {:.*$} $qtmp \"\" qtmp\n"
|
|
" if {$qonly} {\n"
|
|
" set rargs [list \"-Q\" \"$qtmp\"]\n"
|
|
" set print_getout 1\n"
|
|
" set qargs \"\"\n"
|
|
" } else {\n"
|
|
" set rargs [list \"-R\" \"$new\"]\n"
|
|
" set qargs \"\"\n"
|
|
" }\n"
|
|
" set getout 1\n"
|
|
"\n"
|
|
" } elseif {[value_is_string $item]} {\n"
|
|
" # string var:\n"
|
|
" set rargs [list \"-R\" \"$name:$new\"]\n"
|
|
" set qargs [list \"-Q\" \"$name\"]\n"
|
|
" } else {\n"
|
|
" # boolean var:\n"
|
|
" set rargs [list \"-R\" \"$name\"]\n"
|
|
" set qargs [list \"-Q\" \"$name\"]\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {! $query && ! $always_update} {\n"
|
|
" set getout 1\n"
|
|
" } elseif {$item == \"noremote\"} {\n"
|
|
" set getout 1\n"
|
|
" } elseif {[is_action $item] && ![opt_match Q $item] && $rargs != \"\"} {\n"
|
|
" set getout 1\n"
|
|
" } elseif {[regexp {^(sid|id)$} $item] && ![regexp {^0x} $new]} {\n"
|
|
" set getout 1\n"
|
|
" }\n"
|
|
"\n"
|
|
" set remote_output \"\"\n"
|
|
" set query_output \"\"\n"
|
|
"\n"
|
|
" if {!$debug} {\n"
|
|
" append_text \"x11vnc $rargs ...\"\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {$getout} {\n"
|
|
" set remote_output [run_remote_cmd $rargs]\n"
|
|
" if {$print_getout} {\n"
|
|
" append_text \"\\t$remote_output\"\n"
|
|
" }\n"
|
|
" append_text \"\\n\"\n"
|
|
" return\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {$do_query_all} {\n"
|
|
" set all [all_query_vars]\n"
|
|
" set qargs [list \"-Q\" $all]\n"
|
|
" }\n"
|
|
"\n"
|
|
" set rqargs [concat $rargs $qargs]\n"
|
|
"\n"
|
|
" set query [run_remote_cmd $rqargs]\n"
|
|
" set query_output $query\n"
|
|
"\n"
|
|
" set query_result_list \"\"\n"
|
|
"\n"
|
|
" if {$newnew != \"\"} {\n"
|
|
" set new $newnew\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {![see_if_ok $query $item \"$name:$new\"]} {\n"
|
|
" # failed\n"
|
|
" if {[regexp {^a..=} $query]} {\n"
|
|
" # but some result came back\n"
|
|
" # synchronize everything with a 2nd call.\n"
|
|
" set query_output [query_all 1]\n"
|
|
" } else {\n"
|
|
" # server may be dead\n"
|
|
" if {$item != \"ping\" && $item != \"attach\"} {\n"
|
|
" try_connect\n"
|
|
" }\n"
|
|
" }\n"
|
|
" } else {\n"
|
|
" # succeeded\n"
|
|
" # synchronize this variable (or variables)\n"
|
|
" # for a speedup used the list parsed by see_if_ok.\n"
|
|
" update_menu_vars \"USE_LIST\"\n"
|
|
"\n"
|
|
" if {$do_query_all} {\n"
|
|
" global all_settings\n"
|
|
" set all_settings $query\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"# For updating a string variable. Also used for simple OK/Skip dialogs\n"
|
|
"# with entry = 0.\n"
|
|
"proc entry_dialog {item {entry 1}} {\n"
|
|
" global menu_var entry_str entry_set entry_dialog_item\n"
|
|
" global unset_str connected_to_x11vnc\n"
|
|
"\n"
|
|
" set entry_str \"Set $item\"\n"
|
|
" set entry_set 0\n"
|
|
" set entry_dialog_item $item\n"
|
|
"\n"
|
|
" entry_enable\n"
|
|
" menus_disable\n"
|
|
"\n"
|
|
" if {$entry} {\n"
|
|
" entry_insert \"\"\n"
|
|
" if {[info exists menu_var($item)] &&\n"
|
|
" $menu_var($item) != $unset_str} {\n"
|
|
" entry_insert $menu_var($item)\n"
|
|
" entry_select\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {[is_browse $item]} {\n"
|
|
" entry_browse_button\n"
|
|
" }\n"
|
|
" set_info \"Set parameter in entry box, \"\n"
|
|
" entry_focus\n"
|
|
" } else {\n"
|
|
" entry_disable box\n"
|
|
" }\n"
|
|
"\n"
|
|
" update\n"
|
|
"\n"
|
|
" # wait for user reply:\n"
|
|
" vwait entry_set\n"
|
|
"\n"
|
|
" set rc $entry_set\n"
|
|
" set entry_set 0\n"
|
|
"\n"
|
|
" set value [entry_get]\n"
|
|
" update\n"
|
|
"\n"
|
|
" entry_browse_button 0\n"
|
|
" set entry_str \"Set... :\"\n"
|
|
"\n"
|
|
" entry_delete\n"
|
|
" entry_disable\n"
|
|
" menus_enable\n"
|
|
" update\n"
|
|
"\n"
|
|
" if {! $entry} {\n"
|
|
" ;\n"
|
|
" } elseif {$rc} {\n"
|
|
" set menu_var($item) $value\n"
|
|
" } else {\n"
|
|
" if {[in_debug_mode]} {\n"
|
|
" append_text \"skipped setting $item\\n\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" return $rc\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc warning_dialog {msg {item \"gui\"} } {\n"
|
|
" append_text $msg\n"
|
|
" # just reuse the entry widgets for a yes/no dialog\n"
|
|
" return [entry_dialog $item 0]\n"
|
|
"}\n"
|
|
"\n"
|
|
"# For updating a boolean toggle:\n"
|
|
"proc check_var {item} {\n"
|
|
" global menu_var\n"
|
|
"\n"
|
|
" set inval $menu_var($item);\n"
|
|
"\n"
|
|
" if {$item == \"debug_gui\"} {\n"
|
|
" return \"\";\n"
|
|
" }\n"
|
|
"\n"
|
|
" set rname $item\n"
|
|
" if {! $inval} {\n"
|
|
" if {[regexp {^no} $item]} {\n"
|
|
" regsub {^no} $rname \"\" rname\n"
|
|
" } else {\n"
|
|
" set rname \"no$rname\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" return $rname\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc see_if_ok {query item expected} {\n"
|
|
" global query_result_list\n"
|
|
"\n"
|
|
" set ok 0\n"
|
|
" set found \"\"\n"
|
|
"\n"
|
|
" set query_result_list [split_query $query]\n"
|
|
"\n"
|
|
" foreach q $query_result_list {\n"
|
|
" # XXX following will crash if $item is not a good regexp\n"
|
|
" # need to protect it \\Q$item\\E style...\n"
|
|
"# if {[regexp \"^$item:\" $q]} {\n"
|
|
"# set found $q\n"
|
|
"# }\n"
|
|
" if {[string first \"$item:\" $q] == 0} {\n"
|
|
" set found $q\n"
|
|
" }\n"
|
|
" if {$q == $expected} {\n"
|
|
" set ok 1\n"
|
|
" if {$found != \"\"} {\n"
|
|
" break;\n"
|
|
" }\n"
|
|
" }\n"
|
|
" }\n"
|
|
" if {$found == \"\"} {\n"
|
|
" set msg $query\n"
|
|
" regsub {^a..=} $msg {} msg\n"
|
|
" if {[string length $msg] > 60} {\n"
|
|
" set msg [string range $msg 0 60]\n"
|
|
" }\n"
|
|
" } else {\n"
|
|
" set msg $found\n"
|
|
" }\n"
|
|
" if {$ok} {\n"
|
|
" append_text \"\\tSet OK ($msg)\\n\"\n"
|
|
" return 1\n"
|
|
"\n"
|
|
" } elseif {[opt_match P $item] && [regexp {:(-|\\+)} $expected]} {\n"
|
|
" # e.g. blackout:+30x30+20+20\n"
|
|
" append_text \"\\t($msg)\\n\"\n"
|
|
" return 1\n"
|
|
" } else {\n"
|
|
" append_text \"\\t*FAILED* $msg\\n\"\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc update_menu_vars {{query \"\"}} {\n"
|
|
" global all_settings menu_var query_result_list\n"
|
|
"\n"
|
|
" set debug [in_debug_mode]\n"
|
|
"\n"
|
|
" if {$query == \"USE_LIST\"} {\n"
|
|
" ;\n"
|
|
" } elseif {$query == \"\"} {\n"
|
|
" set query_result_list [split_query $all_settings]\n"
|
|
" } else {\n"
|
|
" set query_result_list [split_query $query]\n"
|
|
" }\n"
|
|
"\n"
|
|
" foreach piece $query_result_list {\n"
|
|
" if {[regexp {^([^:][^:]*):(.*)$} $piece m0 item val]} {\n"
|
|
" if {[info exists menu_var($item)]} {\n"
|
|
" set old $menu_var($item)\n"
|
|
" if {$val == \"N/A\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {0 && $debug} {\n"
|
|
" puts \"setting menuvar: $item: $old -> $val\"\n"
|
|
" }\n"
|
|
" set menu_var($item) $val\n"
|
|
" }\n"
|
|
" if {$item == \"clients\"} {\n"
|
|
" update_clients_menu $val\n"
|
|
" }\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc clear_all {} {\n"
|
|
" global menu_var unset_str\n"
|
|
"\n"
|
|
" set debug [in_debug_mode]\n"
|
|
" \n"
|
|
" foreach item [array names menu_var] {\n"
|
|
" if {$item == \"debug_gui\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {[info exists menu_var($item)]} {\n"
|
|
" if [is_action $item] {\n"
|
|
" set menu_var($item) \"\"\n"
|
|
" } elseif {[value_is_bool $item]} {\n"
|
|
" set menu_var($item) 0\n"
|
|
" } elseif {[value_is_string $item]} {\n"
|
|
" set menu_var($item) $unset_str\n"
|
|
" }\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc all_query_vars {} {\n"
|
|
" global query_ans_list query_aro_list all_settings\n"
|
|
" global cache_all_query_vars\n"
|
|
" \n"
|
|
" if {$cache_all_query_vars != \"\"} {\n"
|
|
" return $cache_all_query_vars\n"
|
|
" }\n"
|
|
"\n"
|
|
" set qry \"\"\n"
|
|
" foreach item $query_ans_list {\n"
|
|
" if {$qry == \"\"} {\n"
|
|
" set qry $item\n"
|
|
" } else {\n"
|
|
" append qry \",$item\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" foreach item $query_aro_list {\n"
|
|
" if {$qry == \"\"} {\n"
|
|
" set qry $item\n"
|
|
" } else {\n"
|
|
" append qry \",$item\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" set cache_all_query_vars $qry\n"
|
|
"\n"
|
|
" return $qry\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc query_all {{quiet 0}} {\n"
|
|
" global query_ans_list query_aro_list all_settings\n"
|
|
"\n"
|
|
" set qry [all_query_vars]\n"
|
|
"\n"
|
|
" set qargs [list \"-Q\" $qry]\n"
|
|
" set all [run_remote_cmd $qargs]\n"
|
|
"\n"
|
|
" if {[regexp {ans=} $all]} {\n"
|
|
" if {! $quiet} {\n"
|
|
" append_text \"Retrieved all settings.\\n\"\n"
|
|
" }\n"
|
|
" set all_settings $all\n"
|
|
" update_menu_vars $all\n"
|
|
" } else {\n"
|
|
" if {! $quiet} {\n"
|
|
" append_text \"Failed to retrieve settings.\\n\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" return $all\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc set_info {str} {\n"
|
|
" global info_str\n"
|
|
" set info_str \"$str\"\n"
|
|
" update\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc append_text {str} {\n"
|
|
" global text_area\n"
|
|
" $text_area insert end $str\n"
|
|
" $text_area see end\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc show_all_settings {} {\n"
|
|
" global all_settings\n"
|
|
" set txt \"\\nRead-Write setting:\\n\\n\"\n"
|
|
" foreach item [split_query $all_settings] {\n"
|
|
" regsub {:} $item {: } item\n"
|
|
" append txt \" $item\\n\"\n"
|
|
" if {[regexp {noremote} $item]} {\n"
|
|
" append txt \"\\nRead-Only setting:\\n\\n\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" textwin \"Settings\" \"All Current Settings\" $txt\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc set_connected {yesno} {\n"
|
|
" global connected_to_x11vnc\n"
|
|
" set orig $connected_to_x11vnc\n"
|
|
" \n"
|
|
" if {$yesno == \"yes\"} {\n"
|
|
" set connected_to_x11vnc 1\n"
|
|
" } else {\n"
|
|
" set connected_to_x11vnc 0\n"
|
|
" no_x11_display\n"
|
|
" no_vnc_display\n"
|
|
" }\n"
|
|
" if {$orig != $connected_to_x11vnc} {\n"
|
|
" set_widgets\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc detach_from_display {} {\n"
|
|
" global connected_to_x11vnc reply_xdisplay x11vnc_xdisplay\n"
|
|
" set str \"Detaching from X display.\"\n"
|
|
" if {$reply_xdisplay != \"\"} {\n"
|
|
" set str \"Detaching from $reply_xdisplay.\"\n"
|
|
" } elseif {$x11vnc_xdisplay != \"\"} {\n"
|
|
" set str \"Detaching from $x11vnc_xdisplay.\"\n"
|
|
" }\n"
|
|
" if {$connected_to_x11vnc} {\n"
|
|
" append_text \"$str\\n\"\n"
|
|
" }\n"
|
|
" set_connected no\n"
|
|
"}\n"
|
|
"\n"
|
|
"# Menu item is an action:\n"
|
|
"proc do_action {item} {\n"
|
|
" global menu_var connected_to_x11vnc\n"
|
|
"\n"
|
|
" if {[in_debug_mode]} {\n"
|
|
" append_text \"action: \\\"$item\\\"\\n\"\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {$item == \"ping\"} {\n"
|
|
" try_connect\n"
|
|
" return\n"
|
|
" } elseif {$item == \"start\"} {\n"
|
|
" start_x11vnc\n"
|
|
" return\n"
|
|
" } elseif {$item == \"detach\"} {\n"
|
|
" detach_from_display\n"
|
|
" return\n"
|
|
" } elseif {$item == \"attach\"} {\n"
|
|
" try_connect_and_query_all\n"
|
|
" return\n"
|
|
" } elseif {$item == \"update-all\"} {\n"
|
|
" query_all\n"
|
|
" return\n"
|
|
" } elseif {$item == \"clear-all\"} {\n"
|
|
" clear_all\n"
|
|
" return\n"
|
|
" } elseif {$item == \"show-start-cmd\"} {\n"
|
|
" show_start_cmd\n"
|
|
" return\n"
|
|
" } elseif {$item == \"all-settings\"} {\n"
|
|
" show_all_settings\n"
|
|
" return\n"
|
|
" } elseif {$item == \"stop+quit\"} {\n"
|
|
" push_new_value \"stop\" \"stop\" 1 0\n"
|
|
" set_connected no\n"
|
|
" update\n"
|
|
" after 500\n"
|
|
" destroy .\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {[value_is_string $item]} {\n"
|
|
" if {! [entry_dialog $item]} {\n"
|
|
" return\n"
|
|
" }\n"
|
|
" set new $menu_var($item)\n"
|
|
" set name $item\n"
|
|
" } else {\n"
|
|
" set new 1\n"
|
|
" set name $item\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {! $connected_to_x11vnc} {\n"
|
|
" ;\n"
|
|
" } elseif {[regexp {^(stop|quit|exit|shutdown)$} $item]} {\n"
|
|
" # just do -R\n"
|
|
" append_text \"stopping remote x11vnc server...\\n\"\n"
|
|
" push_new_value $item $name $new 0\n"
|
|
" set_connected no\n"
|
|
" \n"
|
|
" } elseif [opt_match Q $item] {\n"
|
|
" push_new_value $item $name $new 1\n"
|
|
" } else {\n"
|
|
" push_new_value $item $name $new 0\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc ptime {time} {\n"
|
|
" set usec [lindex [split $time] 0]\n"
|
|
" set sec [format \"%.3f\" [expr \"$usec / 1000000.0\"]]\n"
|
|
" puts \"time: $sec secs.\"\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc do_var {item} {\n"
|
|
" global connected_to_x11vnc item_cascade menu_var\n"
|
|
"\n"
|
|
" set debug [in_debug_mode]\n"
|
|
"\n"
|
|
" set string 0\n"
|
|
" if {[is_action $item]} {\n"
|
|
" # Menu item is action:\n"
|
|
" if {$debug} {\n"
|
|
" ptime [time {do_action $item}]\n"
|
|
" } else {\n"
|
|
" do_action $item\n"
|
|
" }\n"
|
|
" return\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {[value_is_string $item]} {\n"
|
|
" # Menu item is a string:\n"
|
|
" if {$item_cascade($item) != \"\"} {\n"
|
|
" # Cascade sets variable automatically\n"
|
|
" } else {\n"
|
|
" # Otherwise Entry box\n"
|
|
" if {![entry_dialog $item]} {\n"
|
|
" return\n"
|
|
" }\n"
|
|
" }\n"
|
|
" set new $menu_var($item)\n"
|
|
" set name $item\n"
|
|
" } else {\n"
|
|
" # Menu item is a boolean:\n"
|
|
" set name [check_var $item]\n"
|
|
" if {$name == \"\"} {\n"
|
|
" return\n"
|
|
" }\n"
|
|
" set new 1\n"
|
|
" }\n"
|
|
" if {$connected_to_x11vnc} {\n"
|
|
" if {$debug} {\n"
|
|
" ptime [time {push_new_value $item $name $new 1}]\n"
|
|
" } else {\n"
|
|
" push_new_value $item $name $new 1\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc menu_help {item} {\n"
|
|
" if ![help_win $item] {\n"
|
|
" textwin \"nohelp\" \"No help available\" \\\n"
|
|
" \"Sorry, no help avaiable for \\\"$item\\\"\"\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc opt_match {c item} {\n"
|
|
" global item_opts\n"
|
|
" if {[info exists item_opts($item)]} {\n"
|
|
" if {[regexp \"^\\[A-z\\]*$c\" $item_opts($item)]} {\n"
|
|
" return 1\n"
|
|
" }\n"
|
|
" }\n"
|
|
" return 0\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc is_action {item} {\n"
|
|
" return [opt_match A $item]\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc is_gui_internal {item} {\n"
|
|
" return [opt_match G $item]\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc is_browse {item} {\n"
|
|
" return [opt_match F $item]\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc value_is_string {item} {\n"
|
|
" global item_bool\n"
|
|
" if {! $item_bool($item)} {\n"
|
|
" return 1\n"
|
|
" } else {\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc value_is_bool {item} {\n"
|
|
" global item_bool\n"
|
|
" if {$item_bool($item)} {\n"
|
|
" return 1\n"
|
|
" } else {\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc split_query0 {query} {\n"
|
|
" # original slower way with regexp/regsub\n"
|
|
" regsub -all {aro=} $query {ans=} query\n"
|
|
" set items {}\n"
|
|
" while {1} {\n"
|
|
" if {! [regexp {^ans=(.*)$} $query m0 m1]} {\n"
|
|
" break\n"
|
|
" }\n"
|
|
" set item $m1\n"
|
|
" set m2 \"\"\n"
|
|
" regexp {,ans=.*$} $item m2\n"
|
|
" regsub {,ans=.*$} $item \"\" item\n"
|
|
" if {$item != \"\"} {\n"
|
|
" lappend items $item\n"
|
|
" }\n"
|
|
" set query $m2\n"
|
|
" regsub {^,} $query \"\" query\n"
|
|
" }\n"
|
|
" return $items\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc split_query {query} {\n"
|
|
" regsub -all {aro=} $query {ans=} query\n"
|
|
" set items {}\n"
|
|
" while {1} {\n"
|
|
" set n [string first \"ans=\" $query]\n"
|
|
" if {$n < 0} {\n"
|
|
" break\n"
|
|
" }\n"
|
|
" set from [expr $n+4]\n"
|
|
"\n"
|
|
" set m [string first \",ans=\" $query]\n"
|
|
" if {$m < 0} {\n"
|
|
" set more 0\n"
|
|
" set item [string range $query $from end]\n"
|
|
" } else {\n"
|
|
" set more 1\n"
|
|
" set to [expr $m-1]\n"
|
|
" set item [string range $query $from $to]\n"
|
|
" }\n"
|
|
" if {$item != \"\"} {\n"
|
|
" lappend items $item\n"
|
|
" }\n"
|
|
" if {$more} {\n"
|
|
" incr m\n"
|
|
" set query [string range $query $m end]\n"
|
|
" } else {\n"
|
|
" set query \"\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" return $items\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc set_x11_display {name} {\n"
|
|
" global x11_display\n"
|
|
" set x11_display \"x11vnc X display: $name\"\n"
|
|
"}\n"
|
|
"proc set_vnc_display {name} {\n"
|
|
" global vnc_display\n"
|
|
" set vnc_display \"VNC display: $name\"\n"
|
|
"}\n"
|
|
"proc no_x11_display {} {\n"
|
|
" set_x11_display \"(*none*)\"\n"
|
|
"}\n"
|
|
"proc no_vnc_display {} {\n"
|
|
" set_vnc_display \"(*none*)\"\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc fetch_displays {} {\n"
|
|
"\n"
|
|
" set qargs [list \"-Q\" \"display,vncdisplay\"]\n"
|
|
" set result [run_remote_cmd $qargs]\n"
|
|
"\n"
|
|
" set got_x11 0\n"
|
|
" set got_vnc 0\n"
|
|
"\n"
|
|
" foreach item [split_query $result] {\n"
|
|
" if {[regexp {^display:(.*)$} $item m0 m1]} {\n"
|
|
" set_x11_display $m1\n"
|
|
" set got_x11 1\n"
|
|
" } elseif {[regexp {^vncdisplay:(.*)$} $item m0 m1]} {\n"
|
|
" set_vnc_display $m1\n"
|
|
" set got_vnc 1\n"
|
|
" }\n"
|
|
" }\n"
|
|
" if {! $got_x11} {\n"
|
|
" no_x11_display\n"
|
|
" }\n"
|
|
" if {! $got_vnc} {\n"
|
|
" no_vnc_display\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc disconnect_dialog {client} {\n"
|
|
" set cid \"\"\n"
|
|
" set host \"\"\n"
|
|
" set msg \"\\n\"\n"
|
|
" append msg \"*** Client info string: $client\\n\"\n"
|
|
" if {[regexp {^(.*):(.*)/(.*)-(.*)$} $client m0 m1 m2 m3 m4]} {\n"
|
|
" if {$m4 == \"ro\"} {\n"
|
|
" set view \"(viewonly)\"\n"
|
|
" } else {\n"
|
|
" set view \"(interactive)\"\n"
|
|
" }\n"
|
|
" set host $m1\n"
|
|
" set cid $m3\n"
|
|
" append msg \"*** Host: $m1, Port: $m2 Id: $m3 $view\\n\"\n"
|
|
" }\n"
|
|
" if {$cid == \"\"} {\n"
|
|
" append_text \"Invalid client info string: $client\\n\"\n"
|
|
" return\n"
|
|
" }\n"
|
|
" append msg \"*** To disconnect this client press \\\"OK\\\", otherwise press \\\"Skip\\\"\\n\"\n"
|
|
" bell\n"
|
|
" if [warning_dialog $msg \"current\"] {\n"
|
|
" push_new_value \"disconnect\" \"disconnect\" $cid 1\n"
|
|
" } else {\n"
|
|
" append_text \"disconnect cancelled.\\n\"\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc update_clients_and_repost {} {\n"
|
|
" global item_cascade menu_m menu_b\n"
|
|
"\n"
|
|
" append_text \"Refreshing connected clients list... \"\n"
|
|
" query_all 1\n"
|
|
" update\n"
|
|
"\n"
|
|
" set saw 0\n"
|
|
" set casc $item_cascade(current)\n"
|
|
" set last [$casc index end]\n"
|
|
" for {set i 0} {$i <= $last} {incr i} {\n"
|
|
" if {[$casc type $i] == \"separator\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" set name [$casc entrycget $i -label]\n"
|
|
" if {[regexp {^#} $name]} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {[regexp {^refresh-list} $name]} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {! $saw} {\n"
|
|
" append_text \"\\n\"\n"
|
|
" }\n"
|
|
" set saw 1\n"
|
|
" append_text \"client: $name\\n\"\n"
|
|
" }\n"
|
|
" if {! $saw} {\n"
|
|
" append_text \"done.\\n\"\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc update_clients_menu {list} {\n"
|
|
" global item_cascade\n"
|
|
" set subm $item_cascade(current);\n"
|
|
" catch {destroy $subm}\n"
|
|
" menu $subm -tearoff 0\n"
|
|
" $subm add command\n"
|
|
" $subm add command -label \"refresh-list\" -command \"update_clients_and_repost\"\n"
|
|
" $subm add separator\n"
|
|
" set count 0\n"
|
|
" foreach client [split $list \",\"] {\n"
|
|
" regsub {:[0-9][0-9]*/} $client {/} lab\n"
|
|
" $subm add command -label \"$client\" \\\n"
|
|
" -command \"disconnect_dialog $client\"\n"
|
|
" incr count\n"
|
|
" }\n"
|
|
" $subm entryconfigure 0 -label \"#clients: $count\"\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc set_widgets {} {\n"
|
|
" global connected_to_x11vnc item_case item_entry menu_m\n"
|
|
"\n"
|
|
" foreach item [array names item_case] {\n"
|
|
" set case $item_case($item)\n"
|
|
" set menu $menu_m($case)\n"
|
|
" set entry $item_entry($item)\n"
|
|
" set type [$menu type $entry]\n"
|
|
" if {$type == \"separator\" || $type == \"tearoff\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {$connected_to_x11vnc} {\n"
|
|
" if {[active_when_connected $item]} {\n"
|
|
" $menu entryconfigure $entry -state normal\n"
|
|
" } else {\n"
|
|
" $menu entryconfigure $entry -state disabled\n"
|
|
" }\n"
|
|
" } else {\n"
|
|
" if {[active_when_starting $item]} {\n"
|
|
" $menu entryconfigure $entry -state normal\n"
|
|
" } else {\n"
|
|
" $menu entryconfigure $entry -state disabled\n"
|
|
" }\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc make_widgets {} {\n"
|
|
" global template \n"
|
|
" global menu_b menu_m\n"
|
|
" global item_opts item_bool item_case item_entry menu_var unset_str\n"
|
|
" global item_cascade\n"
|
|
" global info_str x11_display vnc_display\n"
|
|
" global text_area\n"
|
|
" global entry_box entry_str entry_set entry_label entry_ok entry_browse\n"
|
|
" global entry_help entry_skip\n"
|
|
" global bfont\n"
|
|
" global helptext helpremote helplabel\n"
|
|
"\n"
|
|
"set v 0\n"
|
|
" \n"
|
|
" label .info -textvariable info_str -bd 2 -relief groove -anchor w \n"
|
|
" pack .info -side top -fill x \n"
|
|
"\n"
|
|
" # Extract the Rows:\n"
|
|
" set row 0;\n"
|
|
" set colmax 0;\n"
|
|
" foreach line [split $template \"\\n\"] {\n"
|
|
" if {[regexp {^Row: (.*)} $line rest]} {\n"
|
|
" set col 0\n"
|
|
" foreach case [split $rest] {\n"
|
|
" if {$case == \"\" || $case == \"Row:\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" set menu_row($case) $row\n"
|
|
" set menu_col($case) $col\n"
|
|
" set menu_count($case) 0\n"
|
|
"\n"
|
|
" lappend cases($col) $case;\n"
|
|
" set len [string length $case]\n"
|
|
" if {[info exists max_len($col)]} {\n"
|
|
" if {$len > $max_len($col)} {\n"
|
|
" set max_len($col) $len\n"
|
|
" }\n"
|
|
" } else {\n"
|
|
" set max_len($col) $len\n"
|
|
" }\n"
|
|
" incr col\n"
|
|
" if {$col > $colmax} {\n"
|
|
" set colmax $col\n"
|
|
" }\n"
|
|
" }\n"
|
|
" incr row;\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" # Make frames for the rows and make the menu buttons.\n"
|
|
" set f \".menuframe\"\n"
|
|
" frame $f\n"
|
|
" for {set c 0} {$c < $colmax} {incr c} {\n"
|
|
" set colf \"$f.menuframe$c\"\n"
|
|
" frame $colf\n"
|
|
" pack $colf -side left -fill y\n"
|
|
" set fbg [$colf cget -background]\n"
|
|
" foreach case $cases($c) {\n"
|
|
" set menub \"$colf.menu$case\";\n"
|
|
" set menu \"$colf.menu$case.menu\";\n"
|
|
" set menu_b($case) $menub\n"
|
|
" set menu_m($case) $menu\n"
|
|
" set ul 0\n"
|
|
" foreach char [split $case \"\"] {\n"
|
|
" set char [string tolower $char]\n"
|
|
" if {![info exists underlined($char)]} {\n"
|
|
" set underlined($char) 1\n"
|
|
" break\n"
|
|
" }\n"
|
|
" incr ul\n"
|
|
" }\n"
|
|
" menubutton $menub -text \"$case\" -underline $ul \\\n"
|
|
" -anchor w -menu $menu -background $fbg \\\n"
|
|
" -font $bfont\n"
|
|
" pack $menub -side top -fill x\n"
|
|
" menu $menu -tearoff 0\n"
|
|
" }\n"
|
|
" }\n"
|
|
" pack $f -side top -fill x\n"
|
|
"\n"
|
|
" # Now extract the menu items:\n"
|
|
" set case \"\";\n"
|
|
" foreach line [split $template \"\\n\"] {\n"
|
|
" if {[regexp {^Row:} $line]} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {[regexp {^[A-z]} $line]} {\n"
|
|
" set case [string trim $line]\n"
|
|
" continue;\n"
|
|
" }\n"
|
|
" set item [string trim $line]\n"
|
|
" regsub -all { *} $item \" \" item\n"
|
|
" if {$item == \"\"} {\n"
|
|
" continue;\n"
|
|
" }\n"
|
|
" set opts \"\"\n"
|
|
" if {[regexp {^=} $item]} {\n"
|
|
" set opts [lindex [split $item] 0]\n"
|
|
" regsub {^=} $opts \"\" opts\n"
|
|
" set item [lindex [split $item] 1]\n"
|
|
" }\n"
|
|
" if {[regexp {^0} $opts]} {\n"
|
|
" continue;\n"
|
|
" }\n"
|
|
" if {[regexp {:$} $item]} {\n"
|
|
" set bool 0\n"
|
|
" } else {\n"
|
|
" set bool 1\n"
|
|
" }\n"
|
|
" regsub {:$} $item {} item\n"
|
|
"\n"
|
|
" set item_opts($item) $opts\n"
|
|
" set item_case($item) $case\n"
|
|
" set item_bool($item) $bool\n"
|
|
" set item_cascade($item) \"\"\n"
|
|
" set item_entry($item) $menu_count($case)\n"
|
|
"\n"
|
|
"if {$v} { puts \"ITEM: $item - $opts - $case - $bool - $menu_count($case)\" }\n"
|
|
"\n"
|
|
" set mvar 0 \n"
|
|
" set m $menu_m($case)\n"
|
|
"\n"
|
|
" # Create the menu items, its variables, etc., etc.\n"
|
|
"\n"
|
|
" if {$item == \"--\"} {\n"
|
|
" $m add separator\n"
|
|
"\n"
|
|
" } elseif {$item == \"Quit\"} {\n"
|
|
" # Quit item must shut us down:\n"
|
|
" $m add command -label \"$item\" -underline 0 \\\n"
|
|
" -command {destroy .; exit 0}\n"
|
|
"\n"
|
|
" } elseif {$case == \"Help\"} {\n"
|
|
" # Help is simple help:\n"
|
|
" $m add command -label \"$item\" \\\n"
|
|
" -command \"menu_help $item\"\n"
|
|
"\n"
|
|
" } elseif {$item == \"current\"} {\n"
|
|
" # Current clients cascade\n"
|
|
" set subm $m.cascade$menu_count($case)\n"
|
|
" set item_cascade($item) $subm\n"
|
|
" update_clients_menu \"\"\n"
|
|
" $m add cascade -label \"$item\" \\\n"
|
|
" -menu $subm\n"
|
|
"\n"
|
|
" } elseif {[is_action $item]} {\n"
|
|
" # Action\n"
|
|
" $m add command -label \"$item\" \\\n"
|
|
" -command \"do_var $item\"\n"
|
|
" set menu_var($item) \"\"; # for convenience\n"
|
|
"\n"
|
|
" } elseif {! $item_bool($item)} {\n"
|
|
" # String\n"
|
|
" if {[regexp -- {-C:(.*)} $item_opts($item) m0 m1]} {\n"
|
|
" # Radiobutton select\n"
|
|
" set subm $m.cascade$menu_count($case)\n"
|
|
" menu $subm -tearoff 0\n"
|
|
" foreach val [split $m1 \",\"] {\n"
|
|
" $subm add radiobutton -label \"$val\" \\\n"
|
|
" -command \"do_var $item\" \\\n"
|
|
" -value \"$val\" \\\n"
|
|
" -variable menu_var($item)\n"
|
|
" }\n"
|
|
" $m add cascade -label \"$item\" \\\n"
|
|
" -menu $subm\n"
|
|
" set item_cascade($item) $subm\n"
|
|
" } else {\n"
|
|
" # Arbitrary_string\n"
|
|
" $m add command -label \"$item\" \\\n"
|
|
" -command \"do_var $item\"\n"
|
|
" }\n"
|
|
" set mvar 1\n"
|
|
"\n"
|
|
" } else {\n"
|
|
" # Boolean\n"
|
|
" $m add checkbutton -label \"$item\" \\\n"
|
|
" -command \"do_var $item\" \\\n"
|
|
" -variable menu_var($item)\n"
|
|
" set menu_var($item) 0\n"
|
|
" }\n"
|
|
"\n"
|
|
" incr menu_count($case)\n"
|
|
" if {$mvar} {\n"
|
|
" set menu_var($item) $unset_str\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" # Now make the litte \"(?)\" help buttons\n"
|
|
" foreach case [array names menu_m] {\n"
|
|
" if {$case == \"Help\"} {\n"
|
|
" continue;\n"
|
|
" }\n"
|
|
" set m $menu_m($case);\n"
|
|
" set n [$m index end]\n"
|
|
"\n"
|
|
"if {$v} { puts \"$case end: $n\" }\n"
|
|
"\n"
|
|
" for {set i 0} {$i <= $n} {incr i} {\n"
|
|
" set type [$m type $i]\n"
|
|
" if {$type == \"separator\"} {\n"
|
|
" $m add separator\n"
|
|
" } elseif {$type == \"tearoff\"} {\n"
|
|
" continue;\n"
|
|
" } else {\n"
|
|
" set label [$m entrycget $i -label]\n"
|
|
" set str \"\"\n"
|
|
" if {[info exists helpremote($label)]} {\n"
|
|
" set str \"(?)\"\n"
|
|
" } elseif {[info exists helptext($label)]} {\n"
|
|
" set str \"(?)\"\n"
|
|
" }\n"
|
|
" $m add command -label $str \\\n"
|
|
" -command \"menu_help $label\";\n"
|
|
"\n"
|
|
"if {$v} {\n"
|
|
" set ht \"\"; set hr \"\"\n"
|
|
" if {[info exists helptext($label)]} { set ht \"YES\" }\n"
|
|
" if {[info exists helpremote($label)]} { set hr \"YES\" }\n"
|
|
" puts \"'$label'\\tht='$ht' hr='$hr'\"\n"
|
|
"}\n"
|
|
"\n"
|
|
" if {$str == \"\"} {\n"
|
|
" $m entryconfigure end -state disabled\n"
|
|
" }\n"
|
|
" set arg \"$m,$i\"\n"
|
|
" set helplabel($arg) $label\n"
|
|
" set j [$m index end]\n"
|
|
" set arg \"$m,$j\"\n"
|
|
" set helplabel($arg) $label\n"
|
|
" }\n"
|
|
" if {$i == 0} {\n"
|
|
" $m entryconfigure end -columnbreak 1\n"
|
|
" }\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" # Make the x11 and vnc display label bar:\n"
|
|
" set df .displayframe\n"
|
|
" frame $df -bd 1 -relief groove\n"
|
|
"\n"
|
|
" set df_x11 \"$df.xdisplay\"\n"
|
|
" no_x11_display\n"
|
|
" label $df_x11 -textvariable x11_display -width 35 -anchor w\n"
|
|
"\n"
|
|
" set df_vnc \"$df.vdisplay\"\n"
|
|
" no_vnc_display\n"
|
|
" label $df_vnc -textvariable vnc_display -width 35 -anchor w\n"
|
|
"\n"
|
|
" pack $df_x11 $df_vnc -side left \n"
|
|
" pack $df -side top -fill x\n"
|
|
"\n"
|
|
" # text area\n"
|
|
" text .text -height 11 -relief ridge\n"
|
|
" set text_area .text\n"
|
|
" pack .text -side top -fill both -expand 1\n"
|
|
"\n"
|
|
"\n"
|
|
" set str \"Click Help -> gui for overview.\"\n"
|
|
" append_text \"\\n$str\\n\\n\"\n"
|
|
"\n"
|
|
" # Make entry box stuff\n"
|
|
" set ef .entryframe\n"
|
|
" frame $ef -bd 1 -relief groove\n"
|
|
"\n"
|
|
" # Label\n"
|
|
" set ef_label \"$ef.label\"\n"
|
|
" label $ef_label -textvariable entry_str -anchor w -font $bfont\n"
|
|
"\n"
|
|
" set entry_str \"Set... : \"\n"
|
|
" set ef_entry \"$ef.entry\"\n"
|
|
" entry $ef_entry -relief sunken\n"
|
|
" bind $ef_entry <KeyPress-Return> {set entry_set 1}\n"
|
|
" bind $ef_entry <KeyPress-Escape> {set entry_set 0}\n"
|
|
"\n"
|
|
" # OK button\n"
|
|
" set ef_ok \"$ef.ok\"\n"
|
|
" button $ef_ok -text OK -pady 1 -command {set entry_set 1} \\\n"
|
|
" -font $bfont\n"
|
|
"\n"
|
|
" # Skip button\n"
|
|
" set ef_skip \"$ef.skip\"\n"
|
|
" button $ef_skip -text Skip -pady 0 -command {set entry_set 0} \\\n"
|
|
" -font $bfont\n"
|
|
"\n"
|
|
" # Help button\n"
|
|
" set ef_help \"$ef.help\"\n"
|
|
" button $ef_help -text Help -pady 0 -command \\\n"
|
|
" {menu_help $entry_dialog_item} -font $bfont\n"
|
|
"\n"
|
|
" # Browse button\n"
|
|
" set ef_browse \"$ef.browse\"\n"
|
|
" button $ef_browse -text \"Browse...\" -pady 0 -font $bfont \\\n"
|
|
" -command {entry_insert [tk_getOpenFile]} \n"
|
|
"\n"
|
|
" pack $ef_label -side left\n"
|
|
" pack $ef_entry -side left -fill x -expand 1\n"
|
|
" pack $ef_ok -side right\n"
|
|
" pack $ef_skip -side right\n"
|
|
" pack $ef_help -side right\n"
|
|
" pack $ef -side bottom -fill x\n"
|
|
"\n"
|
|
" set entry_ok $ef_ok\n"
|
|
" set entry_skip $ef_skip\n"
|
|
" set entry_help $ef_help\n"
|
|
" set entry_box $ef_entry\n"
|
|
" set entry_browse $ef_browse\n"
|
|
" set entry_label $ef_label\n"
|
|
" entry_disable\n"
|
|
"\n"
|
|
" update\n"
|
|
" wm minsize . [winfo width .] [winfo height .]\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc menu_bindings {} {\n"
|
|
" bind Menu <<MenuSelect>> {\n"
|
|
"#syntax hilite bug \\\n"
|
|
"MenuSelect>>\n"
|
|
" set n [%W index active]\n"
|
|
" set label \" \"\n"
|
|
" if {$n != \"none\"} {\n"
|
|
" set str %W,$n\n"
|
|
" set which \"\"\n"
|
|
" if {[info exists helplabel($str)]} {\n"
|
|
" set vname [format %%-16s $helplabel($str)]\n"
|
|
" set label \"Click (?) for help on: $vname\"\n"
|
|
" set which $helplabel($str)\n"
|
|
" }\n"
|
|
" if {$which == \"\"} {\n"
|
|
" ;\n"
|
|
" } elseif {[is_action $which]} {\n"
|
|
" if {[info exists menu_var($which)] \n"
|
|
" && $menu_var($which) != \"\"} {\n"
|
|
" set label \"$label value: $menu_var($which)\"\n"
|
|
" } else {\n"
|
|
" set label \"$label (is action)\"\n"
|
|
" }\n"
|
|
" } elseif {[info exists menu_var($which)]} {\n"
|
|
" set label \"$label value: $menu_var($which)\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" set_info $label\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc key_bindings {} {\n"
|
|
" global env menus_disabled\n"
|
|
" if {[info exists env(USER)] && $env(USER) == \"runge\"} {\n"
|
|
" # quick restart\n"
|
|
" bind . <Control-KeyPress-c> {exec $argv0 $argv &; destroy .}\n"
|
|
" }\n"
|
|
" bind . <Control-KeyPress-p> { \\\n"
|
|
" global menus_disabled; \\\n"
|
|
" if {!$menus_disabled} {try_connect_and_query_all} \\\n"
|
|
" }\n"
|
|
" bind . <Control-KeyPress-u> { \\\n"
|
|
" global menus_disabled; \\\n"
|
|
" if {!$menus_disabled} {query_all 0} \\\n"
|
|
" }\n"
|
|
" bind . <Control-KeyPress-r> { \\\n"
|
|
" global menus_disabled; \\\n"
|
|
" if {!$menus_disabled} {query_all 0} \\\n"
|
|
" }\n"
|
|
" bind . <Control-KeyPress-d> { \\\n"
|
|
" global menus_disabled; \\\n"
|
|
" if {!$menus_disabled} {detach_from_display} \\\n"
|
|
" }\n"
|
|
" bind . <Control-KeyPress-a> { \\\n"
|
|
" global menus_disabled; \\\n"
|
|
" if {!$menus_disabled} {try_connect_and_query_all} \\\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc stop_watch {onoff} {\n"
|
|
" global orig_cursor text_area entry_box\n"
|
|
"\n"
|
|
" set widgets [list . $text_area $entry_box] \n"
|
|
"\n"
|
|
" if {$onoff == \"on\"} {\n"
|
|
" foreach item $widgets {\n"
|
|
" $item config -cursor {watch}\n"
|
|
" }\n"
|
|
" } else {\n"
|
|
" foreach item $widgets {\n"
|
|
" $item config -cursor {}\n"
|
|
" }\n"
|
|
" }\n"
|
|
" update\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc double_check_noremote {} {\n"
|
|
" set msg \"\\n\\n\"\n"
|
|
" append msg \"WARNING: setting \\\"noremote\\\" will disable ALL remote control commands\\n\"\n"
|
|
" append msg \"WARNING: (i.e. this gui will be locked out) Do you really want to do this?\\n\"\n"
|
|
" append msg \"WARNING: If so, press \\\"OK\\\", otherwise press \\\"Skip\\\"\\n\"\n"
|
|
" append msg \"\\n\"\n"
|
|
" bell\n"
|
|
" return [warning_dialog $msg \"noremote\"]\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc double_check_start_x11vnc {} {\n"
|
|
" global hostname\n"
|
|
" set msg [get_start_x11vnc_txt]\n"
|
|
" append msg \"\\n\"\n"
|
|
" append msg \"*** To run the above command on machine \\\"$hostname\\\" to\\n\"\n"
|
|
" append msg \"*** start x11vnc press \\\"OK\\\" otherwise press \\\"Skip\\\".\\n\"\n"
|
|
" return [warning_dialog $msg \"start\"]\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc get_start_x11vnc_txt {} {\n"
|
|
" set cmd [get_start_x11vnc_cmd]\n"
|
|
" set str [join $cmd]\n"
|
|
" set msg \"\"\n"
|
|
" append msg \"\\n\"\n"
|
|
" append msg \"==== The command built so far is: ====\\n\";\n"
|
|
" append msg \"\\n\"\n"
|
|
" append msg \"$str\\n\"\n"
|
|
" return $msg\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc show_start_cmd {} {\n"
|
|
" set msg [get_start_x11vnc_txt]\n"
|
|
" append_text \"$msg\\n\"\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc get_start_x11vnc_cmd {{show_rc 0}} {\n"
|
|
" global menu_var unset_str x11vnc_prog\n"
|
|
"\n"
|
|
" set xterm_cmd \"xterm -iconic -geometry 80x35 -title x11vnc-console -e\"\n"
|
|
"\n"
|
|
" set cmd [split $xterm_cmd]\n"
|
|
"\n"
|
|
" lappend cmd $x11vnc_prog\n"
|
|
"\n"
|
|
" set rc_txt \"\"\n"
|
|
"\n"
|
|
" set saw_id 0\n"
|
|
"\n"
|
|
" foreach item [lsort [array names menu_var]] {\n"
|
|
" if {![active_when_starting $item]} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {[is_action $item]} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {$item == \"debug_gui\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {$item == \"id\" || $item == \"sid\"} {\n"
|
|
" set val $menu_var($item);\n"
|
|
" if {$val == \"0x0\" || $val == \"root\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" }\n"
|
|
" if {$item == \"sid\" && $saw_id} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {$item == \"id\"} {\n"
|
|
" set saw_id 1\n"
|
|
" }\n"
|
|
" if {$item == \"progressive\" && $menu_var($item) == \"0\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {$item == \"dontdisconnect\" && $menu_var($item) == \"-1\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
" if {$item == \"alwaysshared\" && $menu_var($item) == \"-1\"} {\n"
|
|
" continue\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {[value_is_bool $item]} {\n"
|
|
" if {[info exists menu_var($item)]} {\n"
|
|
" if {$menu_var($item)} {\n"
|
|
" lappend cmd \"-$item\"\n"
|
|
" append rc_txt \"-$item\\n\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" } elseif {[value_is_string $item]} {\n"
|
|
" if {[info exists menu_var($item)]} {\n"
|
|
" if {$menu_var($item) != \"\"\n"
|
|
" && $menu_var($item) != $unset_str} {\n"
|
|
" set nitem $item\n"
|
|
" if {$nitem == \"screen_blank\"} {\n"
|
|
" set nitem \"sb\"\n"
|
|
" } elseif {$nitem == \"xrandr_mode\"} {\n"
|
|
" set nitem \"xrandr\"\n"
|
|
" }\n"
|
|
" lappend cmd \"-$nitem\"\n"
|
|
" lappend cmd $menu_var($item)\n"
|
|
" append rc_txt \"-$nitem $menu_var($item)\\n\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" }\n"
|
|
" }\n"
|
|
" lappend cmd \"2>\"\n"
|
|
" lappend cmd \"/dev/null\"\n"
|
|
" lappend cmd \"&\"\n"
|
|
" \n"
|
|
" if {$show_rc} {\n"
|
|
" return $rc_txt\n"
|
|
" } else {\n"
|
|
" return $cmd\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc start_x11vnc {} {\n"
|
|
" global menu_var unset_str\n"
|
|
" global x11vnc_prog x11vnc_xdisplay\n"
|
|
" global connected_to_x11vnc\n"
|
|
"\n"
|
|
" if {$connected_to_x11vnc} {\n"
|
|
" append_text \"\\n\"\n"
|
|
" append_text \"WARNING: Still connected to an x11vnc server.\\n\"\n"
|
|
" append_text \"WARNING: Use \\\"stop\\\" or \\\"detach\\\" first.\\n\"\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
"\n"
|
|
" if {![double_check_start_x11vnc]} {\n"
|
|
" return\n"
|
|
" }\n"
|
|
"\n"
|
|
" set x11vnc_xdisplay \"\"\n"
|
|
" if {[info exists menu_var(display)]} {\n"
|
|
" if {$menu_var(display) != \"\" && $menu_var(display) != $unset_str} {\n"
|
|
" set x11vnc_xdisplay $menu_var(display)\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" set cmd [get_start_x11vnc_cmd]\n"
|
|
"\n"
|
|
" set str [join $cmd]\n"
|
|
" regsub { -e} $str \" -e \\\\\\n \" str\n"
|
|
"\n"
|
|
" if {0} {\n"
|
|
" puts \"running: $str\"\n"
|
|
" foreach word $cmd {\n"
|
|
" puts \" word: $word\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" append_text \"Starting x11vnc in an iconified xterm with command:\\n\"\n"
|
|
" append_text \" $str\\n\\n\"\n"
|
|
" catch {[eval exec $cmd]}\n"
|
|
" after 500\n"
|
|
" try_connect_and_query_all 3\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc run_remote_cmd {opts} {\n"
|
|
" global menu_var x11vnc_prog x11vnc_cmdline x11vnc_xdisplay\n"
|
|
"\n"
|
|
" set debug [in_debug_mode]\n"
|
|
"\n"
|
|
" if {[lindex $opts 0] == \"-R\" && [lindex $opts 1] == \"noremote\"} {\n"
|
|
" set str [join $opts]\n"
|
|
" if ![double_check_noremote] {\n"
|
|
" append_text \"skipping: x11vnc $str\"\n"
|
|
" return \"\"\n"
|
|
" } else {\n"
|
|
" append_text \"running: x11vnc $str (please do \\\"Actions -> detach\\\" to clean things up)\\n\"\n"
|
|
" append_text \"subsequent -R/-Q commands should fail...\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" set cmd \"\"\n"
|
|
"\n"
|
|
" lappend cmd $x11vnc_prog;\n"
|
|
"\n"
|
|
" if {$x11vnc_xdisplay != \"\"} {\n"
|
|
" lappend cmd \"-display\"\n"
|
|
" lappend cmd $x11vnc_xdisplay\n"
|
|
" }\n"
|
|
" lappend cmd \"-sync\"\n"
|
|
" foreach word $opts {\n"
|
|
" lappend cmd $word\n"
|
|
" }\n"
|
|
" lappend cmd \"2>\"\n"
|
|
" lappend cmd \"/dev/null\"\n"
|
|
"\n"
|
|
"if {0} {\n"
|
|
" set str [join $cmd]\n"
|
|
" puts \"running: $str\"\n"
|
|
" foreach word $cmd {\n"
|
|
" puts \" word: $word\"\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
" set output \"\"\n"
|
|
" menus_disable\n"
|
|
" stop_watch on\n"
|
|
" catch {set output [eval exec $cmd]}\n"
|
|
" stop_watch off\n"
|
|
" menus_enable\n"
|
|
" if {$debug} {\n"
|
|
" if {[string length $output] > 100} {\n"
|
|
" set str [string range $output 0 100]\n"
|
|
" append_text \"output: $str ...\\n\"\n"
|
|
" } else {\n"
|
|
" append_text \"output: $output\\n\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" return $output\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc try_connect_and_query_all {{n 2}} {\n"
|
|
" for {set i 0} {$i < $n} {incr i} {\n"
|
|
" if {$i > 0} {\n"
|
|
" after 500\n"
|
|
" append_text \"trying again ...\\n\"\n"
|
|
" }\n"
|
|
" if {[try_connect]} {\n"
|
|
" query_all\n"
|
|
" break\n"
|
|
" }\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"proc try_connect {} {\n"
|
|
" global x11vnc_xdisplay connected_to_x11vnc reply_xdisplay\n"
|
|
" global menu_var unset_str\n"
|
|
"\n"
|
|
" if {! $connected_to_x11vnc} {\n"
|
|
" if {[info exists menu_var(display)]} {\n"
|
|
" set d $menu_var(display)\n"
|
|
" if {$d != \"\" && $d != $unset_str && $d != $x11vnc_xdisplay} {\n"
|
|
" set x11vnc_xdisplay $menu_var(display)\n"
|
|
" append_text \"Setting X display to: $x11vnc_xdisplay\\n\"\n"
|
|
" }\n"
|
|
" }\n"
|
|
" }\n"
|
|
"\n"
|
|
" set_info \"Pinging $x11vnc_xdisplay ...\"\n"
|
|
" set rargs [list \"-Q\" \"ping\"]\n"
|
|
" set result [run_remote_cmd $rargs]\n"
|
|
"\n"
|
|
" if {[regexp {^ans=ping:} $result]} {\n"
|
|
" regsub {^ans=ping:} $result {} reply_xdisplay\n"
|
|
" set msg \"Connected to $reply_xdisplay\"\n"
|
|
" set_info $msg\n"
|
|
" append_text \"$msg\\n\"\n"
|
|
" set_connected yes\n"
|
|
" fetch_displays\n"
|
|
" return 1\n"
|
|
" } else {\n"
|
|
" set str \"x11vnc server.\"\n"
|
|
" if {$x11vnc_xdisplay != \"\"} {\n"
|
|
" set str $x11vnc_xdisplay\n"
|
|
" }\n"
|
|
" set msg \"No reply from $str\"\n"
|
|
" set_info $msg\n"
|
|
" append_text \"$msg\\n\"\n"
|
|
" set_connected no\n"
|
|
" return 0\n"
|
|
" }\n"
|
|
"}\n"
|
|
"\n"
|
|
"############################################################################\n"
|
|
"# main:\n"
|
|
"\n"
|
|
"global env x11vnc_prog x11vnc_cmdline x11vnc_xdisplay x11vnc_connect;\n"
|
|
"global helpall helptext helpremote helplabel hostname;\n"
|
|
"global all_settings reply_xdisplay always_update\n"
|
|
"global max_text_height max_text_width\n"
|
|
"global menu_var unset_str menus_disabled\n"
|
|
"global bfont\n"
|
|
"global connected_to_x11vnc\n"
|
|
"global delay_sleep extra_sleep extra_sleep_split\n"
|
|
"global cache_all_query_vars\n"
|
|
"\n"
|
|
"set unset_str \"(unset)\"\n"
|
|
"set connected_to_x11vnc 0\n"
|
|
"set menus_disabled 0\n"
|
|
"set max_text_height 40\n"
|
|
"set max_text_width 90\n"
|
|
"set bfont -adobe-helvetica-bold-r-*-*-*-120-*-*-*-*-*-*;\n"
|
|
"set help_indent 24;\n"
|
|
"set reply_xdisplay \"\"\n"
|
|
"set all_settings \"None so far.\"\n"
|
|
"set always_update 1\n"
|
|
"set cache_all_query_vars \"\"\n"
|
|
"\n"
|
|
"# these are no longer used under x11vnc -sync:\n"
|
|
"set delay_sleep 350\n"
|
|
"set extra_sleep 1000\n"
|
|
"set extra_sleep_split 4\n"
|
|
"\n"
|
|
"if {\"$argv\" == \"-spit\"} {\n"
|
|
" set fh [open $argv0 r]\n"
|
|
" puts \"/*\"\n"
|
|
" puts \" * tkx11vnc.h: generated by 'tkx11vnc -spit'\"\n"
|
|
" puts \" * Abandon all hope, ye who enter here...\"\n"
|
|
" puts \" * ...edit tkx11vnc instead.\"\n"
|
|
" puts \" */\"\n"
|
|
" puts \" char gui_code\\[\\] =\"\n"
|
|
" while {[gets $fh line] > -1} {\n"
|
|
" regsub -all {\\\\} $line {\\\\\\\\} line\n"
|
|
" regsub -all {\"} $line {\\\\\"} line\n"
|
|
" puts \"\\\"$line\\\\n\\\"\"\n"
|
|
" }\n"
|
|
" close $fh\n"
|
|
" puts \";\"\n"
|
|
" exit 0\n"
|
|
"}\n"
|
|
"\n"
|
|
"# Read environment for clues:\n"
|
|
"if {[info exists env(X11VNC_PROG)]} {\n"
|
|
" set x11vnc_prog $env(X11VNC_PROG);\n"
|
|
"} else {\n"
|
|
" set x11vnc_prog \"x11vnc\";\n"
|
|
"}\n"
|
|
"\n"
|
|
"if {[info exists env(X11VNC_CMDLINE)]} {\n"
|
|
" set x11vnc_cmdline $env(X11VNC_CMDLINE);\n"
|
|
"} else {\n"
|
|
" set x11vnc_cmdline \"\";\n"
|
|
"}\n"
|
|
"\n"
|
|
"if {[info exists env(X11VNC_CONNECT)]} {\n"
|
|
" set x11vnc_connect 1\n"
|
|
"} else {\n"
|
|
" set x11vnc_connect 0;\n"
|
|
"}\n"
|
|
"\n"
|
|
"if {[info exists env(X11VNC_XDISPLAY)]} {\n"
|
|
" set x11vnc_xdisplay $env(X11VNC_XDISPLAY);\n"
|
|
" set x11vnc_connect 1\n"
|
|
"\n"
|
|
"} elseif {$argv != \"\" && [regexp {:[0-9]} $argv]} {\n"
|
|
" set x11vnc_xdisplay \"$argv\"\n"
|
|
" set x11vnc_connect 1\n"
|
|
"\n"
|
|
"} elseif {[info exists env(DISPLAY)]} {\n"
|
|
" set x11vnc_xdisplay $env(DISPLAY);\n"
|
|
"} else {\n"
|
|
" set x11vnc_xdisplay \":0\";\n"
|
|
"}\n"
|
|
"\n"
|
|
"set hostname [exec uname -n]\n"
|
|
"#puts [exec env]\n"
|
|
"#puts \"x11vnc_xdisplay: $x11vnc_xdisplay\"\n"
|
|
"\n"
|
|
"set env(X11VNC_STD_HELP) 1\n"
|
|
"\n"
|
|
"# scrape the help output for the text and remote control vars:\n"
|
|
"parse_help;\n"
|
|
"parse_remote_help;\n"
|
|
"parse_query_help;\n"
|
|
"\n"
|
|
"# tweaks to duplicate help text:\n"
|
|
"tweak_remote_help lock deny\n"
|
|
"tweak_remote_help unlock deny\n"
|
|
"\n"
|
|
"tweak_both quiet q\n"
|
|
"tweak_help logfile o\n"
|
|
"tweak_both xwarppointer xwarp\n"
|
|
"tweak_both screen_blank sb\n"
|
|
"\n"
|
|
"set_template\n"
|
|
"\n"
|
|
"wm title . \"tkx11vnc\"\n"
|
|
"make_widgets;\n"
|
|
"\n"
|
|
"menu_bindings;\n"
|
|
"key_bindings;\n"
|
|
"\n"
|
|
"if {$x11vnc_connect} {\n"
|
|
" try_connect_and_query_all\n"
|
|
"}\n"
|
|
"set_widgets\n"
|
|
"\n"
|
|
"# main loop.\n"
|
|
;
|