Initial commit of OpenSPARC T2 architecture model.
[OpenSPARC-T2-SAM] / sam-t2 / devtools / amd64 / bin / multixterm
CommitLineData
920dae64
AT
1#!/bin/sh
2# \
3exec 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
281set palette #d8d8ff ;# lavender
282set colorTyping green
283set colorFocusIn aquamarine
284
285set xtermNames {}
286set xtermCmd $env(SHELL)
287set xtermArgs ""
288set cmdDir ~/lib/multixterm
289set inputLabel "stdin window"
290
291set fileMenuMax 30 ;# max number of files shown in File menu
292set tearoffMenuMin 2 ;# min number of files needed to enable the File
293 ;# menu to be torn off
294
295proc 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
307set versionString 1.8
308set versionDate "2004/06/29"
309
310package require Tcl
311catch {package require Tk} ;# early versions of Tk had no package
312package require Expect
313
314proc exit1 {msg} {
315 puts "multixterm: $msg"
316 exit 1
317}
318
319exp_version -exit 5.36
320
321proc tkBad {} {
322 exit1 "requires Tk 8.3.3 or later but you are using Tk $::tk_patchLevel."
323}
324
325if {$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
337set verbose 0
338proc 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
350proc 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
370proc 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
386while {[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
422if {![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
427if {[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}
430set rcFile $dotdir/.multixtermrc
431
432set fileTypes {
433 {{Multixterm Files} *.mxt}
434 {{All Files} *}
435}
436
437proc 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
451if {[file exists $rcFile]} {
452 openFile $rcFile
453} else {
454 verbose "$rcFile: not found"
455}
456
457if {![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
472set activeList {}
473
474# ::names is an array of xterm names indexed by process spawn ids.
475
476set names(x) ""
477unset 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
486proc 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
588proc xtermActiveUpdate {sid} {
589 if {$::activeArray($sid)} {
590 verbose "activating $sid"
591 } else {
592 verbose "deactivating $sid"
593 }
594 activeListUpdate
595}
596
597proc 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
607proc 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
613proc 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
624proc 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
631proc 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
638proc 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######################################################################
675proc 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
685proc sendTo {to} {
686 exp_send -raw -i $to -- $::expect_out(buffer)
687}
688
689# catch the case where there's no selection
690proc xtermPaste {} {catch {xtermSend [selection get]}}
691
692######################################################################
693# clean up an individual process death or xterm death
694######################################################################
695proc 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######################################################################
752tk_setPalette $palette
753
754menu .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
758set files [glob -nocomplain $cmdDir/*]
759set filesLength [llength $files]
760if {$filesLength >= $tearoffMenuMin} {
761 set filesTearoff 1
762} else {
763 set filesTearoff 0
764}
765menu .m.f -tearoff $filesTearoff -title "multixterm files"
766menu .m.e -tearoff 0
767menu .m.help -tearoff 0
768.m.f add command -label Open -command openFile -underline 0
769
770if {$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
787menu .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
792entry .input -textvar inputLabel -justify center -state disabled
793entry .cmd -textvar xtermCmd
794button .exec -text "new xterm" -command {xtermStart $xtermCmd $xtermCmd}
795
796grid .input -sticky ewns
797grid .cmd -sticky ew
798grid .exec -sticky ew -ipadx 3 -ipady 3
799
800grid columnconfigure . 0 -weight 1
801grid rowconfigure . 0 -weight 1 ;# let input window only expand
802
803bind .cmd <Return> {xtermStart $xtermCmd $xtermCmd}
804
805# send all keypresses to xterm
806bind .input <KeyPress> {xtermSend %A ; break}
807bind .input <Alt-KeyPress> {xtermSend \033%A; break}
808bind .input <Meta-KeyPress> {xtermSend \033%A; break}
809bind .input <<Paste>> {xtermPaste ; break}
810bind .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.
814bind .input <Up> {xtermSend \033OA; break}
815bind .input <Down> {xtermSend \033OB; break}
816bind .input <Right> {xtermSend \033OC; break}
817bind .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
823set colorCurrent [.input cget -bg]
824set colorFocusOut $colorCurrent
825
826# change color to show focus
827bind .input <FocusOut> colorFocusOut
828bind .input <FocusIn> colorFocusIn
829proc colorFocusIn {} {.input config -bg [set ::colorCurrent $::colorFocusIn]}
830proc colorFocusOut {} {.input config -bg [set ::colorCurrent $::colorFocusOut]}
831
832# convert normal mouse events to focusIn
833bind .input <1> {focus .input; break}
834bind .input <Shift-1> {focus .input; break}
835
836# ignore all other mouse events that might make selection visible
837bind .input <Double-1> break
838bind .input <Triple-1> break
839bind .input <B1-Motion> break
840bind .input <B2-Motion> break
841
842set scriptName [info script] ;# must get while it's active
843
844proc 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
871proc 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
936proc scrollPage {dir} {
937 tkScrollByPages .help.sb v $dir
938 return -code break
939}
940
941proc 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
954proc xtermKillAll {} {
955 foreach sid [array names ::xtermPid] {
956 exec /bin/kill -9 $::xtermPid($sid)
957 }
958}
959
960rename exit _exit
961proc exit {{x 0}} {xtermKillAll;_exit $x}
962
963wm protocol . WM_DELETE_WINDOW exit
964trap exit SIGINT
965
966######################################################################
967# start any xterms requested
968######################################################################
969proc 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
978initLate
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
983xtermStartAll ;# If nothing has been requested, this is a no-op.
984
985# finally do any explicit command file
986if {[info exists cmdFile]} {
987 openFile $cmdFile
988}
989