/[debian]/multixterm/trunk/multixterm
ViewVC logotype

Contents of /multixterm/trunk/multixterm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 171 - (show annotations)
Sat Feb 25 18:15:46 2006 UTC (15 years, 6 months ago) by gregoa
File size: 30377 byte(s)
Load multixterm-1.8 into debian/multixterm/trunk.

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

  ViewVC Help
Powered by ViewVC 1.1.26