#!/home/jmc/bin/wish4.2 # # This is a wrapper for the ps command. It has been tested on SunOS # 4.1.4 only. It is likely to not work elsewhere, due to the many # gratuitous changes most vendors make to the ps command. # # AUTHOR: John Chambers set me [lindex [wm title .] 0] set host [exec hostname] wm title . "Process table on $host" if [info exists env(D_$me)] {set D $env(D_$me)} else {set D 0} if [info exists env(B_$me)] {set B $env(B_$me)} else {set B 1} if [info exists env(R_$me)] {set R $env(R_$me)} else {set R ridge} if {$D>0} {puts "me=\"$me\" B=\"$B\" D=\"$D\" R=\"$R\""} set EC {-fg cyan} set EF {-expand 1 -fill x} set FB {-bd $B -relief ridge} set bd {-bd 1 -relief ridge} set errmsg {} set pids {} set psid 0 set refresh 60 set row 0 set rows 0 set ROWS 80 if [file exists Help.w] {source Help.w; set errmsg {Try the Help key}} eval frame .mbar $FB eval pack .mbar -side top $EF # Create the menu-bar widgets: eval menubutton .mbar.cmds -text Cmds -menu .mbar.cmds.menu eval frame .mbar.dbg $bd eval frame .mbar.rows $bd eval frame .mbar.refr $bd eval entry .mbar.emsg -textvariable errmsg -width 0 -highlightthickness 0 $bd eval menubutton .mbar.help -text Help -menu .mbar.help.menu # Pack the menu-bar widgets from both ends: eval pack .mbar.cmds -in .mbar -side left eval pack .mbar.refr -in .mbar -side left eval pack .mbar.emsg -in .mbar -side left $EF eval pack .mbar.help -in .mbar -side right eval pack .mbar.dbg -in .mbar -side right eval pack .mbar.rows -in .mbar -side right # Create the refresh widget's contents: eval menubutton .mbar.refr.b -text Refresh -menu .mbar.refr.b.menu -padx 0 menu .mbar.refr.b.menu .mbar.refr.b.menu add command -label "Now" -command {PS [incr psid]} .mbar.refr.b.menu add command -label "Up" -command {incr D} .mbar.refr.b.menu add command -label "Down" -command {incr D -1} eval entry .mbar.refr.v -textvariable refresh $EC -width 0 -highlightthickness 0 -bd 0 pack .mbar.refr.b .mbar.refr.v -in .mbar.refr -side left # Create the rows widget's contents: eval label .mbar.rows.b -text Rows eval entry .mbar.rows.v -textvariable ROWS $EC -width 0 -highlightthickness 0 -bd 0 pack .mbar.rows.b .mbar.rows.v -in .mbar.rows -side left # Create the debug widget's contents: eval menubutton .mbar.dbg.b -text Dbg -menu .mbar.dbg.b.menu -padx 0 menu .mbar.dbg.b.menu .mbar.dbg.b.menu add command -label "Off" -command {set D 0} .mbar.dbg.b.menu add command -label "Up" -command {incr D} .mbar.dbg.b.menu add command -label "Down" -command {incr D -1} eval entry .mbar.dbg.v -textvariable D $EC -width 0 -highlightthickness 0 -bd 0 pack .mbar.dbg.b .mbar.dbg.v -in .mbar.dbg -side left # Create the leftmost "command" menu: menu .mbar.cmds.menu .mbar.cmds.menu add command -label "Quit" -command {exit 0} # The Help menu doesn't do much; the Help button is more functional. menu .mbar.help.menu .mbar.help.menu add command -label "$me" -command {Help $me} #HelpFiles .mbar.help.menu $env(HOME)/help eval frame .p $FB eval pack .p -expand 1 -fill both eval frame .p.c $FB ;# -yscrollcommand {".p.vscroll set"} eval pack .p.c -in .p -expand 1 -fill both #eval scrollbar .p.vscroll -width 8 -command {".p.c yview"} #eval pack .p.vscroll -side right -padx 2 -fill y set clist {usr pid cpu mem siz rss tty stt tim cmd} set clpat {([a-zA-Z0-9]+) +([0-9]+) +([0-9]+\.[0-9]) +([0-9]+\.[0-9]) *([0-9]+) +([0-9]+) +([a-z][0-9a-z]) +(....) +([0-9:]+ +[0-9:]+) *} # usr pid cpu mem siz rss tty stt tim cmd set ttl(usr) USER set ttl(pid) PID set ttl(cpu) %CPU set ttl(mem) %MEM set ttl(siz) SIZE set ttl(rss) RSS set ttl(tty) TT set ttl(stt) ST set ttl(tim) {START TIME} set ttl(cmd) COMMAND set an(usr) w set an(pid) w set an(cpu) e set an(mem) e set an(siz) e set an(rss) e set an(tty) w set an(stt) w set an(tim) w set an(cmd) w foreach c $clist { eval frame .p.$c $FB eval pack .p.$c -in .p -side left -expand 1 -fill y eval label .p.$c.ttl -text {$ttl($c)} -fg yellow -anchor $an($c) eval pack .p.$c.ttl -in .p.$c -side top $EF } proc PS {id} { global B D errmsg me pfile pids psid refresh row set cmd "| ps gawwux | sort -b +1n" if {$id != $psid} { if {$D>0} {puts "$me/PS: Drop id=$id because psid=$psid."} return } if [catch {open $cmd r} f] { set errmsg "Can't run \"$cmd\" ($f)" if {$D>0} {puts "$me/PS: $errmsg"} } else { if {$D>1} {puts "$me/PS: f=$f {$cmd}"} set pfile $f set pids [pid $f] set row 0 fileevent $f readable "Pevent $f $psid" if {$refresh > 0} {after ${refresh}000 PS $id} } } proc Pevent {f id} { global B D an clist clpat errmsg me pfile pids psid ROWS row rows if {$D>5} {puts "$me/Pevent: f=$f id=$id"} if {$pfile != {}} { if {$pfile != $f} { if [catch {close $f} e] { set errmsg "close $f gave $e" } return } } if [eof $f] { if [catch {close $f} e] { set errmsg "close $f gave $e" } else { if {$D>0} {puts "$me/Pevent: $f id=$id done."} set pfile {} } if {$rows > $row} {TrimRows} set rows $row return } gets $f line if {$id != $psid} {return} if [regsub $clpat $line {} rem] { if [eval regexp {$clpat} {$line} match $clist] { if {[lsearch -exact $pids $pid] >= 0} {return} set cmd $rem incr row if {$row > $ROWS} {return} foreach c $clist { global v$c$row set v$c$row [set $c] if {$D>2} {puts "$me c=\"$c\" v=\"$v\""} if ![winfo exists .p.$c.r$row] { entry .p.$c.r$row -textvariable v$c$row -fg green -bd 0 -width 0 ;# -pady 0 -anchor $an($c) pack .p.$c.r$row -in .p.$c -side top -expand 1 -fill x } } } } } proc TrimRows {} { global D clist me ROWS row rows while {$rows > $row} { if {$D>0} {puts "$me: Trim row $rows"} foreach c $clist {if [winfo exists .p.$c.r$rows] {destroy .p.$c.r$rows}} incr rows -1 } } after 1000 PS $psid