| 1 | #!/bin/sh |
| 2 | # \ |
| 3 | exec expectk "$0" ${1+"$@"} |
| 4 | # |
| 5 | # NAME |
| 6 | # multixterm - drive multiple xterms separately or together |
| 7 | # |
| 8 | # SYNOPSIS |
| 9 | # multixterm [-xa "xterm args"] |
| 10 | # [-xc "command"] |
| 11 | # [-xd "directory"] |
| 12 | # [-xf "file"] |
| 13 | # [-xn "xterm names"] |
| 14 | # [-xv] (enable verbose mode) |
| 15 | # [-xh] or [-x?] (help) |
| 16 | # [xterm names or user-defined args...] |
| 17 | # |
| 18 | # DESCRIPTION |
| 19 | # Multixterm creates multiple xterms that can be driven together |
| 20 | # or separately. |
| 21 | # |
| 22 | # In its simplest form, multixterm is run with no arguments and |
| 23 | # commands are interactively entered in the first entry field. |
| 24 | # Press return (or click the "new xterm" button) to create a new |
| 25 | # xterm running that command. |
| 26 | # |
| 27 | # Keystrokes in the "stdin window" are redirected to all xterms |
| 28 | # started by multixterm. xterms may be driven separately simply |
| 29 | # by focusing on them. |
| 30 | # |
| 31 | # The stdin window must have the focus for keystrokes to be sent |
| 32 | # to the xterms. When it has the focus, the color changes to |
| 33 | # aquamarine. As characters are entered, the color changes to |
| 34 | # green for a second. This provides feedback since characters |
| 35 | # are not echoed in the stdin window. |
| 36 | # |
| 37 | # Typing in the stdin window while holding down the alt or meta |
| 38 | # keys sends an escape character before the typed characters. |
| 39 | # This provides support for programs such as emacs. |
| 40 | # |
| 41 | # ARGUMENTS |
| 42 | # The optional -xa argument indicates arguments to pass to |
| 43 | # xterm. |
| 44 | # |
| 45 | # The optional -xc argument indicates a command to be run in |
| 46 | # each named xterm (see -xn). With no -xc argument, the command |
| 47 | # is the current shell. |
| 48 | # |
| 49 | # The optional -xd argument indicates a directory to search for |
| 50 | # files that will appear in the Files menu. By default, the |
| 51 | # directory is: ~/lib/multixterm |
| 52 | # |
| 53 | # The optional -xf argument indicates a file to be read at |
| 54 | # startup. See FILES below for more info. |
| 55 | # |
| 56 | # The optional -xn argument indicates a name for each xterm. |
| 57 | # This name will also be substituted for any %n in the command |
| 58 | # argument (see -xc). |
| 59 | # |
| 60 | # The optional -xv flag puts multixterm into a verbose mode |
| 61 | # where it will describe some of the things it is doing |
| 62 | # internally. The verbose output is not intended to be |
| 63 | # understandable to anyone but the author. |
| 64 | # |
| 65 | # Less common options may be changed by the startup file (see |
| 66 | # FILES below). |
| 67 | # |
| 68 | # All the usual X and wish flags are supported (i.e., -display, |
| 69 | # -name). There are so many of them that to avoid colliding and |
| 70 | # make them easy to remember, all the multixterm flags begin |
| 71 | # with -x. |
| 72 | # |
| 73 | # If any arguments do not match the flags above, the remainder |
| 74 | # of the command line is made available for user processing. By |
| 75 | # default, the remainder is used as a list of xterm names in the |
| 76 | # style of -xn. The default behavior may be changed using the |
| 77 | # .multixtermrc file (see DOT FILE below). |
| 78 | # |
| 79 | # EXAMPLE COMMAND LINE ARGUMENTS |
| 80 | # The following command line starts up two xterms using ssh to |
| 81 | # the hosts bud and dexter. |
| 82 | # |
| 83 | # multixterm -xc "ssh %n" bud dexter |
| 84 | # |
| 85 | # FILES |
| 86 | # Command files may be used to drive or initialize multixterm. |
| 87 | # The File menu may be used to invoke other files. If files |
| 88 | # exist in the command file directory (see -xd above), they will |
| 89 | # appear in the File menu. Files may also be loaded by using |
| 90 | # File->Open. Any filename is acceptable but the File->Open |
| 91 | # browser defaults to files with a .mxt suffix. |
| 92 | # |
| 93 | # Files are written in Tcl and may change any variables or |
| 94 | # invoke any procedures. The primary variables of interest are |
| 95 | # 'xtermCmd' which identifies the command (see -xc) and |
| 96 | # 'xtermNames' which is a list of names (see -xn). The |
| 97 | # procedure xtermStartAll, starts xterms for each name in the |
| 98 | # list. Other variables and procedures may be discovered by |
| 99 | # examining multixterm itself. |
| 100 | # |
| 101 | # EXAMPLE FILE |
| 102 | # The following file does the same thing as the earlier example |
| 103 | # command line: |
| 104 | # |
| 105 | # # start two xterms connected to bud and dexter |
| 106 | # set xtermCmd "ssh %n" |
| 107 | # set xtermNames {bud dexter} |
| 108 | # xtermStartAll |
| 109 | # |
| 110 | # DOT FILE |
| 111 | # At startup, multixterm reads ~/.multixtermrc if present. This |
| 112 | # is similar to the command files (see FILES above) except that |
| 113 | # .multixtermrc may not call xtermStartAll. Instead it is |
| 114 | # called implicitly, similar to the way that it is implicit in |
| 115 | # the command line use of -xn. |
| 116 | # |
| 117 | # The following example .multixtermrc file makes every xterm run |
| 118 | # ssh to the hosts named on the command line. |
| 119 | # |
| 120 | # set xtermCmd "ssh %n" |
| 121 | # |
| 122 | # Then multixterm could be called simply: |
| 123 | # |
| 124 | # multixterm bud dexter |
| 125 | # |
| 126 | # If any command-line argument does not match a multixterm flag, |
| 127 | # the remainder of the command line is made available to |
| 128 | # .multixtermrc in the argv variable. If argv is non-empty when |
| 129 | # .multixtermrc returns, it is assigned to xtermNames unless |
| 130 | # xtermNames is non-empty in which case, the content of argv is |
| 131 | # ignored. |
| 132 | # |
| 133 | # Commands from .multixtermrc are evaluated early in the |
| 134 | # initialization of multixterm. Anything that must be done late |
| 135 | # in the initialization (such as adding additional bindings to |
| 136 | # the user interface) may be done by putting the commands inside |
| 137 | # a procedure called "initLate". |
| 138 | # |
| 139 | # MENUS |
| 140 | # Except as otherwise noted, the menus are self-explanatory. |
| 141 | # Some of the menus have dashed lines as the first entry. |
| 142 | # Clicking on the dashed lines will "tear off" the menus. |
| 143 | # |
| 144 | # USAGE SUGGESTION - ALIASES AND COMMAND FILES |
| 145 | # Aliases may be used to store lengthy command-line invocations. |
| 146 | # Command files can be also be used to store such invocations |
| 147 | # as well as providing a convenient way to share configurations. |
| 148 | # |
| 149 | # Tcl is a general-purpose language. Thus multixterm command |
| 150 | # files can be extremely flexible, such as loading hostnames |
| 151 | # from other programs or files that may change from day-to-day. |
| 152 | # In addition, command files can be used for other purposes. |
| 153 | # For example, command files may be used to prepared common |
| 154 | # canned interaction sequences. For example, the command to |
| 155 | # send the same string to all xterms is: |
| 156 | # |
| 157 | # xtermSend "a particularly long string" |
| 158 | # |
| 159 | # The File menu (torn-off) makes canned sequences particularly |
| 160 | # convenient. Interactions could also be bound to a mouse |
| 161 | # button, keystroke, or added to a menu via the .multixtermrc |
| 162 | # file. |
| 163 | # |
| 164 | # USAGE SUGGESTION - HANDLING MANY XTERMS BY TILING |
| 165 | # The following .multixtermrc causes tiny xterms to tile across |
| 166 | # and down the screen. (You may have to adjust the parameters |
| 167 | # for your screen.) This can be very helpful when dealing with |
| 168 | # large numbers of xterms. |
| 169 | # |
| 170 | # set yPos 0 |
| 171 | # set xPos 0 |
| 172 | # |
| 173 | # trace variable xtermArgs r traceArgs |
| 174 | # |
| 175 | # proc traceArgs {args} { |
| 176 | # global xPos yPos |
| 177 | # set ::xtermArgs "-geometry 80x12+$xPos+$yPos -font 6x10" |
| 178 | # if {$xPos} { |
| 179 | # set xPos 0 |
| 180 | # incr yPos 145 |
| 181 | # if {$yPos > 800} {set yPos 0} |
| 182 | # } else { |
| 183 | # set xPos 500 |
| 184 | # } |
| 185 | # } |
| 186 | # |
| 187 | # The xtermArgs variable in the code above is the variable |
| 188 | # corresponding to the -xa argument. |
| 189 | # |
| 190 | # xterms can be also be created directly. The following command |
| 191 | # file creates three xterms overlapped horizontally: |
| 192 | # |
| 193 | # set xPos 0 |
| 194 | # |
| 195 | # foreach name {bud dexter hotdog} { |
| 196 | # set ::xtermArgs "-geometry 80x12+$xPos+0 -font 6x10" |
| 197 | # set ::xtermNames $name |
| 198 | # xtermStartAll |
| 199 | # incr xPos 300 |
| 200 | # } |
| 201 | # |
| 202 | # USAGE SUGGESTION - SELECTING HOSTS BY NICKNAME |
| 203 | # The following .multixtermrc shows an example of changing the |
| 204 | # default handling of the arguments from hostnames to a filename |
| 205 | # containing hostnames: |
| 206 | # |
| 207 | # set xtermNames [exec cat $argv] |
| 208 | # |
| 209 | # The following is a variation, retrieving the host names from |
| 210 | # the yp database: |
| 211 | # |
| 212 | # set xtermNames [exec ypcat $argv] |
| 213 | # |
| 214 | # The following hardcodes two sets of hosts, so that you can |
| 215 | # call multixterm with either "cluster1" or "cluster2": |
| 216 | # |
| 217 | # switch $argv { |
| 218 | # cluster1 { |
| 219 | # set xtermNames "bud dexter" |
| 220 | # } |
| 221 | # cluster2 { |
| 222 | # set xtermNames "frank hotdog weiner" |
| 223 | # } |
| 224 | # } |
| 225 | # |
| 226 | # COMPARE/CONTRAST |
| 227 | # It is worth comparing multixterm to xkibitz. Multixterm |
| 228 | # connects a separate process to each xterm. xkibitz connects |
| 229 | # the same process to each xterm. |
| 230 | # |
| 231 | # LIMITATIONS |
| 232 | # Multixterm provides no way to remotely control scrollbars, |
| 233 | # resize, and most other window system related functions. |
| 234 | # |
| 235 | # Multixterm can only control new xterms that multixterm itself |
| 236 | # has started. |
| 237 | # |
| 238 | # As a convenience, the File menu shows a limited number of |
| 239 | # files. To show all the files, use File->Open. |
| 240 | # |
| 241 | # FILES |
| 242 | # $DOTDIR/.multixtermrc initial command file |
| 243 | # ~/.multixtermrc fallback command file |
| 244 | # ~/lib/multixterm/ default command file directory |
| 245 | # |
| 246 | # BUGS |
| 247 | # If multixterm is killed using an uncatchable kill, the xterms |
| 248 | # are not killed. This appears to be a bug in xterm itself. |
| 249 | # |
| 250 | # Send/expect sequences can be done in multixterm command files. |
| 251 | # However, due to the richness of the possibilities, to document |
| 252 | # it properly would take more time than the author has at present. |
| 253 | # |
| 254 | # REQUIREMENTS |
| 255 | # Requires Expect 5.36.0 or later. |
| 256 | # Requires Tk 8.3.3 or later. |
| 257 | # |
| 258 | # VERSION |
| 259 | #! $::versionString |
| 260 | # The latest version of multixterm is available from |
| 261 | # http://expect.nist.gov/example/multixterm . If your version of Expect |
| 262 | # and Tk are too old (see REQUIREMENTS above), download a new version of |
| 263 | # Expect from http://expect.nist.gov |
| 264 | # |
| 265 | # DATE |
| 266 | #! $::versionDate |
| 267 | # |
| 268 | # AUTHOR |
| 269 | # Don Libes <don@libes.com> |
| 270 | # |
| 271 | # LICENSE |
| 272 | # Multixterm is in the public domain; however the author would |
| 273 | # appreciate acknowledgement if multixterm or parts of it or ideas from |
| 274 | # it are used. |
| 275 | |
| 276 | ###################################################################### |
| 277 | # user-settable things - override them in the ~/.multixtermrc file |
| 278 | # or via command-line options |
| 279 | ###################################################################### |
| 280 | |
| 281 | set palette #d8d8ff ;# lavender |
| 282 | set colorTyping green |
| 283 | set colorFocusIn aquamarine |
| 284 | |
| 285 | set xtermNames {} |
| 286 | set xtermCmd $env(SHELL) |
| 287 | set xtermArgs "" |
| 288 | set cmdDir ~/lib/multixterm |
| 289 | set inputLabel "stdin window" |
| 290 | |
| 291 | set fileMenuMax 30 ;# max number of files shown in File menu |
| 292 | set tearoffMenuMin 2 ;# min number of files needed to enable the File |
| 293 | ;# menu to be torn off |
| 294 | |
| 295 | proc initLate {} {} ;# anything that must be done late in initialization |
| 296 | ;# such as adding/modifying bindings, may be done by |
| 297 | ;# redefining this |
| 298 | |
| 299 | ###################################################################### |
| 300 | # end of user-settable things |
| 301 | ###################################################################### |
| 302 | |
| 303 | ###################################################################### |
| 304 | # sanity checking |
| 305 | ###################################################################### |
| 306 | |
| 307 | set versionString 1.8 |
| 308 | set versionDate "2004/06/29" |
| 309 | |
| 310 | package require Tcl |
| 311 | catch {package require Tk} ;# early versions of Tk had no package |
| 312 | package require Expect |
| 313 | |
| 314 | proc exit1 {msg} { |
| 315 | puts "multixterm: $msg" |
| 316 | exit 1 |
| 317 | } |
| 318 | |
| 319 | exp_version -exit 5.36 |
| 320 | |
| 321 | proc tkBad {} { |
| 322 | exit1 "requires Tk 8.3.3 or later but you are using Tk $::tk_patchLevel." |
| 323 | } |
| 324 | |
| 325 | if {$tk_version < 8.3} { |
| 326 | tkBad |
| 327 | } elseif {$tk_version == 8.3} { |
| 328 | if {[lindex [split $tk_patchLevel .] 2] < 3} tkBad |
| 329 | } |
| 330 | |
| 331 | ###################################################################### |
| 332 | # process args - has to be done first to get things like -xv working ASAP |
| 333 | ###################################################################### |
| 334 | |
| 335 | # set up verbose mechanism early |
| 336 | |
| 337 | set verbose 0 |
| 338 | proc verbose {msg} { |
| 339 | if {$::verbose} { |
| 340 | if {[info level] > 1} { |
| 341 | set proc [lindex [info level -1] 0] |
| 342 | } else { |
| 343 | set proc main |
| 344 | } |
| 345 | puts "$proc: $msg" |
| 346 | } |
| 347 | } |
| 348 | |
| 349 | # read a single argument from the command line |
| 350 | proc arg_read1 {var args} { |
| 351 | if {0 == [llength $args]} { |
| 352 | set argname -$var |
| 353 | } else { |
| 354 | set argname $args |
| 355 | } |
| 356 | |
| 357 | upvar argv argv |
| 358 | upvar $var v |
| 359 | |
| 360 | verbose "$argname" |
| 361 | if {[llength $argv] < 2} { |
| 362 | exit1 "$argname requires an argument" |
| 363 | } |
| 364 | |
| 365 | set v [lindex $argv 1] |
| 366 | verbose "set $var $v" |
| 367 | set argv [lrange $argv 2 end] |
| 368 | } |
| 369 | |
| 370 | proc xtermUsage {{msg {}}} { |
| 371 | if {![string equal $msg ""]} { |
| 372 | puts "multixtermrc: $msg" |
| 373 | } |
| 374 | puts {usage: multixterm [flags] ... where flags are: |
| 375 | [-xa "xterm args"] |
| 376 | [-xc "command"] |
| 377 | [-xd "directory"] |
| 378 | [-xf "file"] |
| 379 | [-xn "xterm names"] |
| 380 | [-xv] (enable verbose mode) |
| 381 | [-xh] or [-x?] (help) |
| 382 | [xterm names or user-defined args...]} |
| 383 | exit |
| 384 | } |
| 385 | |
| 386 | while {[llength $argv]} { |
| 387 | set flag [lindex $argv 0] |
| 388 | switch -- $flag -x? - -xh { |
| 389 | xtermUsage |
| 390 | } -xc { |
| 391 | arg_read1 xtermCmd -xc |
| 392 | } -xn { |
| 393 | arg_read1 xtermNames -xn |
| 394 | } -xa { |
| 395 | arg_read1 xtermArgs -xa |
| 396 | } -xf { |
| 397 | arg_read1 cmdFile -xf |
| 398 | if {![file exists $cmdFile]} { |
| 399 | exit1 "can't read $cmdFile" |
| 400 | } |
| 401 | } -xd { |
| 402 | arg_read1 cmdDir -xd |
| 403 | if {![file exists $cmdDir]} { |
| 404 | exit1 "can't read $cmdDir" |
| 405 | } |
| 406 | } -xv { |
| 407 | set argv [lrange $argv 1 end] |
| 408 | set verbose 1 |
| 409 | puts "main: verbose on" |
| 410 | } default { |
| 411 | verbose "remaining args: $argv" |
| 412 | break ;# let user handle remaining args later |
| 413 | } |
| 414 | } |
| 415 | |
| 416 | ###################################################################### |
| 417 | # determine and load rc file - has to be done now so that widgets |
| 418 | # can be affected |
| 419 | ###################################################################### |
| 420 | |
| 421 | # if user has no $DOTDIR, fall back to home directory |
| 422 | if {![info exists env(DOTDIR)]} { |
| 423 | set env(DOTDIR) ~ |
| 424 | } |
| 425 | # catch bogus DOTDIR, otherwise glob will lose the bogus directory |
| 426 | # and it won't appear in the error msg |
| 427 | if {[catch {glob $env(DOTDIR)} dotdir]} { |
| 428 | exit1 "$env(DOTDIR)/.multixtermrc can't be found because $env(DOTDIR) doesn't exist or can't be read" |
| 429 | } |
| 430 | set rcFile $dotdir/.multixtermrc |
| 431 | |
| 432 | set fileTypes { |
| 433 | {{Multixterm Files} *.mxt} |
| 434 | {{All Files} *} |
| 435 | } |
| 436 | |
| 437 | proc openFile {{fn {}}} { |
| 438 | verbose "opening $fn" |
| 439 | if {[string equal $fn ""]} { |
| 440 | set fn [tk_getOpenFile \ |
| 441 | -initialdir $::cmdDir \ |
| 442 | -filetypes $::fileTypes \ |
| 443 | -title "multixterm file"] |
| 444 | if {[string match $fn ""]} return |
| 445 | } |
| 446 | uplevel #0 source [list $fn] |
| 447 | verbose "xtermNames = \"$::xtermNames\"" |
| 448 | verbose "xtermCmd = $::xtermCmd" |
| 449 | } |
| 450 | |
| 451 | if {[file exists $rcFile]} { |
| 452 | openFile $rcFile |
| 453 | } else { |
| 454 | verbose "$rcFile: not found" |
| 455 | } |
| 456 | |
| 457 | if {![string equal "" $argv]} { |
| 458 | if {[string equal $xtermNames ""]} { |
| 459 | set xtermNames $argv |
| 460 | } |
| 461 | } |
| 462 | |
| 463 | ###################################################################### |
| 464 | # Describe and initialize some important globals |
| 465 | ###################################################################### |
| 466 | |
| 467 | # ::activeList and ::activeArray both track which xterms to send |
| 468 | # (common) keystrokes to. Each element in activeArray is connected to |
| 469 | # the active menu. The list version is just a convenience making the |
| 470 | # send function easier/faster. |
| 471 | |
| 472 | set activeList {} |
| 473 | |
| 474 | # ::names is an array of xterm names indexed by process spawn ids. |
| 475 | |
| 476 | set names(x) "" |
| 477 | unset names(x) |
| 478 | |
| 479 | # ::xtermSid is an array of xterm spawn ids indexed by process spawn ids. |
| 480 | # ::xtermPid is an array of xterm pids indexed by process spawn id. |
| 481 | |
| 482 | ###################################################################### |
| 483 | # create an xterm and establish connections |
| 484 | ###################################################################### |
| 485 | |
| 486 | proc xtermStart {cmd name} { |
| 487 | verbose "starting new xterm running $cmd with name $name" |
| 488 | |
| 489 | ###################################################################### |
| 490 | # create pty for xterm |
| 491 | ###################################################################### |
| 492 | set pid [spawn -noecho -pty] |
| 493 | verbose "spawn -pty: pid = $pid, spawn_id = $spawn_id" |
| 494 | set sidXterm $spawn_id |
| 495 | stty raw -echo < $spawn_out(slave,name) |
| 496 | |
| 497 | regexp ".*(.)(.)" $spawn_out(slave,name) dummy c1 c2 |
| 498 | if {[string compare $c1 "/"] == 0} { |
| 499 | set c1 0 |
| 500 | } |
| 501 | |
| 502 | ###################################################################### |
| 503 | # prepare to start xterm by making sure xterm name is unique |
| 504 | # X doesn't care but active menu won't make sense unless names are unique |
| 505 | ###################################################################### |
| 506 | set unique 1 |
| 507 | foreach oldName [array names ::names] { |
| 508 | if {[string match "$name" $::names($oldName)]} { |
| 509 | set unique 0 |
| 510 | } |
| 511 | } |
| 512 | verbose "uniqueness of $name: $unique" |
| 513 | |
| 514 | set safe [safe $name] |
| 515 | |
| 516 | # if not unique, look at the numerical suffixes of all matching |
| 517 | # names, find the biggest and increment it |
| 518 | if {!$unique} { |
| 519 | set suffix 2 |
| 520 | foreach oldName [array names ::names] { |
| 521 | verbose "regexp ^[set safe](\[0-9]+)$ $::names($oldName) X num" |
| 522 | if {[regexp "^[set safe](\[0-9]+)$" $::names($oldName) X num]} { |
| 523 | verbose "matched, checking suffix" |
| 524 | if {$num >= $suffix} { |
| 525 | set suffix [expr $num+1] |
| 526 | verbose "new suffix: $suffix" |
| 527 | } |
| 528 | } |
| 529 | } |
| 530 | append name $suffix |
| 531 | verbose "new name: $name" |
| 532 | } |
| 533 | |
| 534 | ###################################################################### |
| 535 | # start new xterm |
| 536 | ###################################################################### |
| 537 | set xtermpid [eval exec xterm -name [list $name] -S$c1$c2$spawn_out(slave,fd) $::xtermArgs &] |
| 538 | verbose "xterm: pid = $xtermpid" |
| 539 | close -slave |
| 540 | |
| 541 | # xterm first sends back window id, save in environment so it can be |
| 542 | # passed on to the new process |
| 543 | log_user 0 |
| 544 | expect { |
| 545 | eof {wait;return} |
| 546 | -re (.*)\n { |
| 547 | # convert hex to decimal |
| 548 | # note quotes must be used here to avoid diagnostic from expr |
| 549 | set ::env(WINDOWID) [expr "0x$expect_out(1,string)"] |
| 550 | } |
| 551 | } |
| 552 | |
| 553 | ###################################################################### |
| 554 | # start new process |
| 555 | ###################################################################### |
| 556 | set pid [eval spawn -noecho $cmd] |
| 557 | verbose "$cmd: pid = $pid, spawn_id = $spawn_id" |
| 558 | set sidCmd $spawn_id |
| 559 | lappend ::activeList $sidCmd |
| 560 | set ::activeArray($sidCmd) 1 |
| 561 | |
| 562 | ###################################################################### |
| 563 | # link everything back to spawn id of new process |
| 564 | ###################################################################### |
| 565 | set ::xtermSid($sidCmd) $sidXterm |
| 566 | set ::names($sidCmd) $name |
| 567 | set ::xtermPid($sidCmd) $xtermpid |
| 568 | |
| 569 | ###################################################################### |
| 570 | # connect proc output to xterm output |
| 571 | # connect xterm input to proc input |
| 572 | ###################################################################### |
| 573 | expect_background { |
| 574 | -i $sidCmd |
| 575 | -re ".+" [list sendTo $sidXterm] |
| 576 | eof [list xtermKill $sidCmd] |
| 577 | -i $sidXterm |
| 578 | -re ".+" [list sendTo $sidCmd] |
| 579 | eof [list xtermKill $sidCmd] |
| 580 | } |
| 581 | |
| 582 | .m.e entryconfig Active -state normal |
| 583 | .m.e.active add checkbutton -label $name -variable activeArray($sidCmd) \ |
| 584 | -command [list xtermActiveUpdate $sidCmd] |
| 585 | set ::activeArray($sidCmd) 1 |
| 586 | } |
| 587 | |
| 588 | proc xtermActiveUpdate {sid} { |
| 589 | if {$::activeArray($sid)} { |
| 590 | verbose "activating $sid" |
| 591 | } else { |
| 592 | verbose "deactivating $sid" |
| 593 | } |
| 594 | activeListUpdate |
| 595 | } |
| 596 | |
| 597 | proc activeListUpdate {} { |
| 598 | set ::activeList {} |
| 599 | foreach n [array names ::activeArray] { |
| 600 | if {$::activeArray($n)} { |
| 601 | lappend ::activeList $n |
| 602 | } |
| 603 | } |
| 604 | } |
| 605 | |
| 606 | # make a string safe to go through regexp |
| 607 | proc safe {s} { |
| 608 | string map {{[} {\[} {*} {\*} {+} {\+} {^} {\^} {$} {\\$}} $s |
| 609 | } |
| 610 | |
| 611 | # utility to map xterm name to spawn id |
| 612 | # multixterm doesn't use this but a user might want to |
| 613 | proc xtermGet {name} { |
| 614 | foreach sid [array names ::names] { |
| 615 | if {[string equal $name $::names($sid)]} { |
| 616 | return $sid |
| 617 | } |
| 618 | } |
| 619 | error "no such term with name: $name" |
| 620 | } |
| 621 | |
| 622 | # utility to activate an xterm |
| 623 | # multixterm doesn't use this but a user might want to |
| 624 | proc xtermActivate {sid} { |
| 625 | set ::activeArray($sid) 1 |
| 626 | xtermActiveUpdate $sid |
| 627 | } |
| 628 | |
| 629 | # utility to deactivate an xterm |
| 630 | # multixterm doesn't use this but a user might want to |
| 631 | proc xtermDeactivate {sid} { |
| 632 | set ::activeArray($sid) 0 |
| 633 | xtermActiveUpdate $sid |
| 634 | } |
| 635 | |
| 636 | # utility to do an explicit Expect |
| 637 | # multixterm doesn't use this but a user might want to |
| 638 | proc xtermExpect {args} { |
| 639 | # check if explicit spawn_id in args |
| 640 | for {set i 0} {$i < [llength $args]} {incr i} { |
| 641 | switch -- [lindex $args $i] "-i" { |
| 642 | set sidCmd [lindex $args [incr i]] |
| 643 | break |
| 644 | } |
| 645 | } |
| 646 | |
| 647 | if {![info exists sidCmd]} { |
| 648 | # nothing explicit, so get it from the environment |
| 649 | |
| 650 | upvar spawn_id spawn_id |
| 651 | |
| 652 | # mimic expect's normal behavior in obtaining spawn_id |
| 653 | if {[info exists spawn_id]} { |
| 654 | set sidCmd $spawn_id |
| 655 | } else { |
| 656 | set sidCmd $::spawn_id |
| 657 | } |
| 658 | } |
| 659 | |
| 660 | # turn off bg expect, do fg expect, then re-enable bg expect |
| 661 | |
| 662 | expect_background -i $sidCmd ;# disable bg expect |
| 663 | eval expect $args ;# fg expect |
| 664 | ;# reenable bg expect |
| 665 | expect_background { |
| 666 | -i $sidCmd |
| 667 | -re ".+" [list sendTo $::xtermSid($sidCmd)] |
| 668 | eof [list xtermKill $sidCmd] |
| 669 | } |
| 670 | } |
| 671 | |
| 672 | ###################################################################### |
| 673 | # connect main window keystrokes to all xterms |
| 674 | ###################################################################### |
| 675 | proc xtermSend {A} { |
| 676 | if {[info exists ::afterId]} { |
| 677 | after cancel $::afterId |
| 678 | } |
| 679 | .input config -bg $::colorTyping |
| 680 | set ::afterId [after 1000 {.input config -bg $colorCurrent}] |
| 681 | |
| 682 | exp_send -raw -i $::activeList -- $A |
| 683 | } |
| 684 | |
| 685 | proc sendTo {to} { |
| 686 | exp_send -raw -i $to -- $::expect_out(buffer) |
| 687 | } |
| 688 | |
| 689 | # catch the case where there's no selection |
| 690 | proc xtermPaste {} {catch {xtermSend [selection get]}} |
| 691 | |
| 692 | ###################################################################### |
| 693 | # clean up an individual process death or xterm death |
| 694 | ###################################################################### |
| 695 | proc xtermKill {s} { |
| 696 | verbose "killing xterm $s" |
| 697 | |
| 698 | if {![info exists ::xtermPid($s)]} { |
| 699 | verbose "too late, already dead" |
| 700 | return |
| 701 | } |
| 702 | |
| 703 | catch {exec /bin/kill -9 $::xtermPid($s)} |
| 704 | unset ::xtermPid($s) |
| 705 | |
| 706 | # remove sid from activeList |
| 707 | verbose "removing $s from active array" |
| 708 | catch {unset ::activeArray($s)} |
| 709 | activeListUpdate |
| 710 | |
| 711 | verbose "removing from background handler $s" |
| 712 | catch {expect_background -i $s} |
| 713 | verbose "removing from background handler $::xtermSid($s)" |
| 714 | catch {expect_background -i $::xtermSid($s)} |
| 715 | verbose "closing proc" |
| 716 | catch {close -i $s} |
| 717 | verbose "closing xterm" |
| 718 | catch {close -i $::xtermSid($s)} |
| 719 | verbose "waiting on proc" |
| 720 | wait -i $s |
| 721 | wait -i $::xtermSid($s) |
| 722 | verbose "done waiting" |
| 723 | unset ::xtermSid($s) |
| 724 | |
| 725 | # remove from active menu |
| 726 | verbose "deleting active menu entry $::names($s)" |
| 727 | |
| 728 | # figure out which it is |
| 729 | # avoid using name as an index since we haven't gone to any pains to |
| 730 | # make it safely interpreted by index-pattern code. instead step |
| 731 | # through, doing the comparison ourselves |
| 732 | set last [.m.e.active index last] |
| 733 | # skip over tearoff |
| 734 | for {set i 1} {$i <= $last} {incr i} { |
| 735 | if {![catch {.m.e.active entrycget $i -label} label]} { |
| 736 | if {[string equal $label $::names($s)]} break |
| 737 | } |
| 738 | } |
| 739 | .m.e.active delete $i |
| 740 | unset ::names($s) |
| 741 | |
| 742 | # if none left, disable menu |
| 743 | # this leaves tearoff clone but that seems reasonable |
| 744 | if {0 == [llength [array names ::xtermSid]]} { |
| 745 | .m.e entryconfig Active -state disable |
| 746 | } |
| 747 | } |
| 748 | |
| 749 | ###################################################################### |
| 750 | # create windows |
| 751 | ###################################################################### |
| 752 | tk_setPalette $palette |
| 753 | |
| 754 | menu .m -tearoff 0 |
| 755 | .m add cascade -menu .m.f -label "File" -underline 0 |
| 756 | .m add cascade -menu .m.e -label "Edit" -underline 0 |
| 757 | .m add cascade -menu .m.help -label "Help" -underline 0 |
| 758 | set files [glob -nocomplain $cmdDir/*] |
| 759 | set filesLength [llength $files] |
| 760 | if {$filesLength >= $tearoffMenuMin} { |
| 761 | set filesTearoff 1 |
| 762 | } else { |
| 763 | set filesTearoff 0 |
| 764 | } |
| 765 | menu .m.f -tearoff $filesTearoff -title "multixterm files" |
| 766 | menu .m.e -tearoff 0 |
| 767 | menu .m.help -tearoff 0 |
| 768 | .m.f add command -label Open -command openFile -underline 0 |
| 769 | |
| 770 | if {$filesLength} { |
| 771 | .m.f add separator |
| 772 | set files [lsort $files] |
| 773 | set files [lrange $files 0 $fileMenuMax] |
| 774 | foreach f $files { |
| 775 | .m.f add command -label $f -command [list openFile $f] |
| 776 | } |
| 777 | .m.f add separator |
| 778 | } |
| 779 | |
| 780 | .m.f add command -label "Exit" -command exit -underline 0 |
| 781 | .m.e add command -label "Paste" -command xtermPaste -underline 0 |
| 782 | .m.e add cascade -label "Active" -menu .m.e.active -underline 0 |
| 783 | .m.help add command -label "About" -command about -underline 0 |
| 784 | .m.help add command -label "Man Page" -command help -underline 0 |
| 785 | . config -m .m |
| 786 | |
| 787 | menu .m.e.active -tearoff 1 -title "multixterm active" |
| 788 | .m.e entryconfig Active -state disabled |
| 789 | # disable the Active menu simply because it looks goofy seeing an empty menu |
| 790 | # for consistency, though, it should be enabled |
| 791 | |
| 792 | entry .input -textvar inputLabel -justify center -state disabled |
| 793 | entry .cmd -textvar xtermCmd |
| 794 | button .exec -text "new xterm" -command {xtermStart $xtermCmd $xtermCmd} |
| 795 | |
| 796 | grid .input -sticky ewns |
| 797 | grid .cmd -sticky ew |
| 798 | grid .exec -sticky ew -ipadx 3 -ipady 3 |
| 799 | |
| 800 | grid columnconfigure . 0 -weight 1 |
| 801 | grid rowconfigure . 0 -weight 1 ;# let input window only expand |
| 802 | |
| 803 | bind .cmd <Return> {xtermStart $xtermCmd $xtermCmd} |
| 804 | |
| 805 | # send all keypresses to xterm |
| 806 | bind .input <KeyPress> {xtermSend %A ; break} |
| 807 | bind .input <Alt-KeyPress> {xtermSend \033%A; break} |
| 808 | bind .input <Meta-KeyPress> {xtermSend \033%A; break} |
| 809 | bind .input <<Paste>> {xtermPaste ; break} |
| 810 | bind .input <<PasteSelection>> {xtermPaste ; break} |
| 811 | |
| 812 | # arrow keys - note that if they've been rebound through .Xdefaults |
| 813 | # you'll have to change these definitions. |
| 814 | bind .input <Up> {xtermSend \033OA; break} |
| 815 | bind .input <Down> {xtermSend \033OB; break} |
| 816 | bind .input <Right> {xtermSend \033OC; break} |
| 817 | bind .input <Left> {xtermSend \033OD; break} |
| 818 | # Strange: od -c reports these as \033[A et al but when keypad mode |
| 819 | # is initialized, they send \033OA et al. Presuming most people |
| 820 | # want keypad mode, I'll go with the O versions. Perhaps the other |
| 821 | # version is just a Sun-ism anyway. |
| 822 | |
| 823 | set colorCurrent [.input cget -bg] |
| 824 | set colorFocusOut $colorCurrent |
| 825 | |
| 826 | # change color to show focus |
| 827 | bind .input <FocusOut> colorFocusOut |
| 828 | bind .input <FocusIn> colorFocusIn |
| 829 | proc colorFocusIn {} {.input config -bg [set ::colorCurrent $::colorFocusIn]} |
| 830 | proc colorFocusOut {} {.input config -bg [set ::colorCurrent $::colorFocusOut]} |
| 831 | |
| 832 | # convert normal mouse events to focusIn |
| 833 | bind .input <1> {focus .input; break} |
| 834 | bind .input <Shift-1> {focus .input; break} |
| 835 | |
| 836 | # ignore all other mouse events that might make selection visible |
| 837 | bind .input <Double-1> break |
| 838 | bind .input <Triple-1> break |
| 839 | bind .input <B1-Motion> break |
| 840 | bind .input <B2-Motion> break |
| 841 | |
| 842 | set scriptName [info script] ;# must get while it's active |
| 843 | |
| 844 | proc about {} { |
| 845 | set w .about |
| 846 | if {[winfo exists $w]} { |
| 847 | wm deiconify $w |
| 848 | raise $w |
| 849 | return |
| 850 | } |
| 851 | toplevel $w |
| 852 | wm title $w "about multixterm" |
| 853 | wm iconname $w "about multixterm" |
| 854 | wm resizable $w 0 0 |
| 855 | |
| 856 | button $w.b -text Dismiss -command [list wm withdraw $w] |
| 857 | |
| 858 | label $w.title -text "multixterm" -font "Times 16" -borderwidth 10 -fg red |
| 859 | label $w.version -text "Version $::versionString, Released $::versionDate" |
| 860 | label $w.author -text "Written by Don Libes <don@libes.com>" |
| 861 | label $w.using -text "Using Expect [exp_version],\ |
| 862 | Tcl $::tcl_patchLevel,\ |
| 863 | Tk $::tk_patchLevel" |
| 864 | grid $w.title |
| 865 | grid $w.version |
| 866 | grid $w.author |
| 867 | grid $w.using |
| 868 | grid $w.b -sticky ew |
| 869 | } |
| 870 | |
| 871 | proc help {} { |
| 872 | if {[winfo exists .help]} { |
| 873 | wm deiconify .help |
| 874 | raise .help |
| 875 | return |
| 876 | } |
| 877 | toplevel .help |
| 878 | wm title .help "multixterm help" |
| 879 | wm iconname .help "multixterm help" |
| 880 | |
| 881 | scrollbar .help.sb -command {.help.text yview} |
| 882 | text .help.text -width 74 -height 30 -yscroll {.help.sb set} -wrap word |
| 883 | |
| 884 | button .help.ok -text Dismiss -command {destroy .help} -relief raised |
| 885 | bind .help <Return> {destroy .help;break} |
| 886 | grid .help.sb -row 0 -column 0 -sticky ns |
| 887 | grid .help.text -row 0 -column 1 -sticky nsew |
| 888 | grid .help.ok -row 1 -columnspan 2 -sticky ew -ipadx 3 -ipady 3 |
| 889 | |
| 890 | # let text box only expand |
| 891 | grid rowconfigure .help 0 -weight 1 |
| 892 | grid columnconfigure .help 1 -weight 1 |
| 893 | |
| 894 | set script [auto_execok $::scriptName] |
| 895 | if {[llength $script] == 0} { |
| 896 | set script /depot/tcl/bin/multixterm ;# fallback |
| 897 | } |
| 898 | if {[catch {open $script} fid]} { |
| 899 | .help.text insert end "Could not open help file: $script" |
| 900 | } else { |
| 901 | # skip to the beginning of the actual help (starts with "NAME") |
| 902 | while {-1 != [gets $fid buf]} { |
| 903 | if {1 == [regexp "NAME" $buf]} { |
| 904 | .help.text insert end "\n NAME\n" |
| 905 | break |
| 906 | } |
| 907 | } |
| 908 | |
| 909 | while {-1 != [gets $fid buf]} { |
| 910 | if {0 == [regexp "^#(.?)(.*)" $buf X key buf]} break |
| 911 | if {$key == "!"} { |
| 912 | set buf [subst -nocommands $buf] |
| 913 | set key " " |
| 914 | } |
| 915 | .help.text insert end $key$buf\n |
| 916 | } |
| 917 | } |
| 918 | |
| 919 | # support scrolling beyond Tk's built-in Next/Previous |
| 920 | foreach w {"" .sb .text .ok} { |
| 921 | set W .help$w |
| 922 | bind $W <space> {scrollPage 1} ;#more |
| 923 | bind $W <Delete> {scrollPage -1} ;#more |
| 924 | bind $W <BackSpace> {scrollPage -1} ;#more |
| 925 | bind $W <Control-v> {scrollPage 1} ;#emacs |
| 926 | bind $W <Meta-v> {scrollPage -1} ;#emacs |
| 927 | bind $W <Control-f> {scrollPage 1} ;#vi |
| 928 | bind $W <Control-b> {scrollPage -1} ;#vi |
| 929 | bind $W <F35> {scrollPage 1} ;#sun |
| 930 | bind $W <F29> {scrollPage -1} ;#sun |
| 931 | bind $W <Down> {scrollLine 1} |
| 932 | bind $W <Up> {scrollLine -1} |
| 933 | } |
| 934 | } |
| 935 | |
| 936 | proc scrollPage {dir} { |
| 937 | tkScrollByPages .help.sb v $dir |
| 938 | return -code break |
| 939 | } |
| 940 | |
| 941 | proc scrollLine {dir} { |
| 942 | tkScrollByUnits .help.sb v $dir |
| 943 | return -code break |
| 944 | } |
| 945 | |
| 946 | ###################################################################### |
| 947 | # exit handling |
| 948 | ###################################################################### |
| 949 | |
| 950 | # xtermKillAll is not intended to be user-callable. It just kills |
| 951 | # the processes and that's it. A user-callable version would update |
| 952 | # the data structures, close the channels, etc. |
| 953 | |
| 954 | proc xtermKillAll {} { |
| 955 | foreach sid [array names ::xtermPid] { |
| 956 | exec /bin/kill -9 $::xtermPid($sid) |
| 957 | } |
| 958 | } |
| 959 | |
| 960 | rename exit _exit |
| 961 | proc exit {{x 0}} {xtermKillAll;_exit $x} |
| 962 | |
| 963 | wm protocol . WM_DELETE_WINDOW exit |
| 964 | trap exit SIGINT |
| 965 | |
| 966 | ###################################################################### |
| 967 | # start any xterms requested |
| 968 | ###################################################################### |
| 969 | proc xtermStartAll {} { |
| 970 | verbose "xtermNames = \"$::xtermNames\"" |
| 971 | foreach n $::xtermNames { |
| 972 | regsub -all "%n" $::xtermCmd $n cmdOut |
| 973 | xtermStart $cmdOut $n |
| 974 | } |
| 975 | set ::xtermNames {} |
| 976 | } |
| 977 | |
| 978 | initLate |
| 979 | |
| 980 | # now that xtermStartAll and its accompanying support has been set up |
| 981 | # run it to start anything defined by rc file or command-line args. |
| 982 | |
| 983 | xtermStartAll ;# If nothing has been requested, this is a no-op. |
| 984 | |
| 985 | # finally do any explicit command file |
| 986 | if {[info exists cmdFile]} { |
| 987 | openFile $cmdFile |
| 988 | } |
| 989 | |