Commit | Line | Data |
---|---|---|
920dae64 AT |
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 |