#!/usr/bin/wish -f
#
# This script generates a process browser, which lists the running
# processes (using unix "ps") and allows you to send signals (such as KILL)
# using a popup menu. 

# Create a scrollbar on the right side of the main window and a listbox
# on the left side.
#
# Adapted/enhanced for Linux by Ed Petron (epetron@leba.net)
# Kidong Lee (kidong@shinbiro.com) May 1997
#
# Originally written by Henry Minsky (hqm@ai.mit.edu) May 1994
# 

proc strip_blanks { str } {
	set tmpstr "" ;
	foreach i $str {
		if {$i != ""} { 
			lappend tmpstr $i 
		}
	}
	return $tmpstr
}

################################################################
# Default settings

set menufont "-Adobe-helvetica-bold-r-normal--*-120-*"
set tfont "fixed"
set sortoption ""

wm title . "tkps - Process Manager"

# The default update time of display is 10 seconds
# You can change it in the configure menu.
set MIN_UPDATE_PERIOD 2000
set UPDATE_PERIOD 10000 

# The default double click behavior
set USER_SIG KILL

# The default command line args to "ps"
set DEFAULT_PS_ARGS  "auxww"

################################################################
# You can get the implementation dependent signal names for your system
# from /usr/include/signal.h
# 

set common_sigs {
{INT	2	interupt}
{QUIT	3	quit}
{IOT	6	abort}
{KILL	9	non-catchable, non-ignorable kill}
{STOP	17	sendable stop signal not from tty}
{ALRM	14	alarm clock}
{TERM	15	software termination signal}
}


# Make a button bar for the common signals
frame .bbar 
button .bbar.kill -text KILL -command { send_signal KILL } -font $menufont
button .bbar.int -text INT -command { send_signal INT } -font $menufont
button .bbar.quit -text QUIT -command { send_signal QUIT } -font $menufont
button .bbar.iot -text IOT -command { send_signal IOT } -font $menufont
button .bbar.term -text TERM -command { send_signal TERM } -font $menufont
button .bbar.stop -text STOP -command { send_signal STOP } -font $menufont
button .bbar.hup -text HUP -command { send_signal HUP } -font $menufont

pack .bbar.kill  .bbar.int .bbar.quit \
		.bbar.iot .bbar.term .bbar.stop .bbar.hup \
		-side left -padx 3m -ipadx 6m -pady 3m

pack .bbar  -side bottom -expand no -fill x -anchor w

bind .bbar.kill <Return> ".bbar.kill flash; .bbar.kill invoke"
bind .bbar.int  <Return> ".bbar.int flash; .bbar.int invoke"
bind .bbar.quit <Return> ".bbar.quit flash; .bbar.quit invoke"
bind .bbar.iot  <Return> ".bbar.iot flash; .bbar.iot invoke"
bind .bbar.term <Return> ".bbar.term flash; .bbar.term invoke"
bind .bbar.stop <Return> ".bbar.stop flash; .bbar.stop invoke"
bind .bbar.hup  <Return> ".bbar.hup flash; .bbar.hup invoke"

set all_sigs {
{HUP	1	hangup}
{INT	2	interrupt}
{QUIT	3	quit}
{ILL	4	illegal instruction (not reset when caught)}
{TRAP	5	trace trap (not reset when caught)}
{ABRT	6	abort()}
{IOT	6	SIGABRT compatibility}
{EMT	7	EMT instruction}
{FPE	8	floating point exception}
{KILL	9	kill (cannot be caught or ignored)}
{BUS	10	bus error}
{SEGV	11	segmentation violation}
{SYS	12	bad argument to system call}
{PIPE	13	write on a pipe with no one to read it}
{ALRM	14	alarm clock}
{TERM	15	software termination signal from kill}
{URG	16	urgent condition on IO channel}
{STOP	17	sendable stop signal not from tty}
{TSTP	18	stop signal from tty}
{CONT	19	continue a stopped process}
{CHLD	20	to parent on child stop or exit}
{TTIN	21	to readers pgrp upon background tty read}
{TTOU	22	like TTIN for output if (tp->t_local&LTOSTOP)}
{IO	23	input/output possible signal}
{XCPU	24	exceeded CPU time limit}
{XFSZ	25	exceeded file size limit}
{VTALRM	26	virtual time alarm}
{PROF	27	profiling time alarm}
{WINCH	28	window size changes}
{INFO	29	information request}
{USR1	30	user defined signal 1}
{USR2	31	user defined signal 2}
}

set posix_sigs {
{HUP	1	hangup}
{INT	2	interrupt}
{QUIT	3	quit}
{ILL	4	illegal instruction (not reset when caught)}
{ABRT	6	abort()}
{FPE	8	floating point exception}
{KILL	9	kill (cannot be caught or ignored)}
{SEGV	11	segmentation violation}
{PIPE	13	write on a pipe with no one to read it}
{ALRM	14	alarm clock}
{TERM	15	software termination signal from kill}
{STOP	17	sendable stop signal not from tty}
{TSTP	18	stop signal from tty}
{CONT	19	continue a stopped process}
{CHLD	20	to parent on child stop or exit}
{TTIN	21	to readers pgrp upon background tty read}
{TTOU	22	like TTIN for output if (tp->t_local&LTOSTOP)}
{USR1	30	user defined signal 1}
{USR2	31	user defined signal 2}
}

################################################################

set common_ps_keywords {
	{%cpu       percentage cpu usage (alias pcpu)}
	{%mem       percentage memory usage (alias pmem)}
	{uid        effective user ID}
	{user       user name (from uid)}
	{majflt     total page faults}
	{minflt     total page reclaims}
	{msgrcv     total messages received (reads from pipes/sockets)}
	{msgsnd     total messages sent (writes on pipes/sockets)}
	{vsz        virtual size in Kbytes (alias vsize)}
	{nice       nice value (alias ni)}
	{nsigs      total signals taken (alias nsignals)}
	{nswap      total swaps in/out}
	{pgid       process group number}
	{pid        process ID}
	{ppid       parent process ID}
	{rgid       real group ID}
	{ruid       real user ID}
	{ruser      user name (from ruid)}
	{start      time started}
	{time       accumulated cpu time, user + system (alias cputime)}
	{tpgid      control terminal process group ID}
	{tsiz       text size (in Kbytes)}
	{tty        full name of control terminal}
	{lim        memoryuse limit}
	{logname    login name of user who started the process}
}

set ALL_ps_keywords {
	{%cpu       percentage cpu usage (alias pcpu)}
	{%mem       percentage memory usage (alias pmem)}
	{acflag     accounting flag (alias acflg)}
	{cpu        short-term cpu usage factor (for scheduling)}
	{inblk      total blocks read (alias inblock)}
	{jobc       job control count}
	{ktrace     tracing flags}
	{ktracep    tracing vnode}
	{lim        memoryuse limit}
	{lstart     time started}
	{majflt     total page faults}
	{minflt     total page reclaims}
	{msgrcv     total messages received (reads from pipes/sockets)}
	{msgsnd     total messages sent (writes on pipes/sockets)}
	{nice       nice value (alias ni)}
	{nivcsw     total involuntary context switches}
	{nsigs      total signals taken (alias nsignals)}
	{nswap      total swaps in/out}
	{nvcsw      total voluntary context switches}
	{nwchan     wait channel (as an address)}
	{oublk      total blocks written (alias oublock)}
	{p_ru       resource usage (valid only for zombie)}
	{paddr      swap address}
	{pagein     pageins (same as majflt)}
	{pgid       process group number}
	{pid        process ID}
	{ppid       parent process ID}
	{pri        scheduling priority}
	{re         core residency time (in seconds; 127 = infinity)}
	{rgid       real group ID}

	{rlink      reverse link on run queue, or 0}
	{rss        resident set size}
	{rsz        resident set size + (text size / text use count) (alias rs- size)}
	{ruid       real user ID}
	{ruser      user name (from ruid)}
	{sess       session pointer}
	{sig        pending signals (alias pending)}
	{sigcatch   caught signals (alias caught)}
	{sigignore  ignored signals (alias ignored)}
	{sigmask    blocked signals (alias blocked)}
	{sl         sleep time (in seconds; 127 = infinity)}
	{start      time started}
	{svgid      saved gid from a setgid executable}
	{svuid      saved uid from a setuid executable}
	{tdev       control terminal device number}
	{time       accumulated cpu time, user + system (alias cputime)}
	{tpgid      control terminal process group ID}
	{tsess      control terminal session pointer}
	{tsiz       text size (in Kbytes)}
	{tt         control terminal name (two letter abbreviation)}
	{tty        full name of control terminal}
	{ucomm      name to be used for accounting}
	{uid        effective user ID}
	{upr        scheduling priority on return from system call (alias usrpri)}
	{user       user name (from uid)}
	{vsz        virtual size in Kbytes (alias vsize)}
	{wchan      wait channel (as a symbolic name)}
	{xstat      exit or stop status (valid only for stopped or zombie process)}
	{logname    login name of user who started the process}

}

set state_fields {
	{D Process in disk (or other short term, uninterruptable) wait.}
	{I Process that is idle (sleeping for longer than about 20 seconds).}
	{P Process in page wait.}
	{R Process is Runnable.}
	{S Process is sleeping for less than about 20 seconds.}
	{T Process is stopped.}
	{Z Process is dead (a ``zombie'').}
	{+ Process is in the foreground process group of its control terminal.}
	{< Process has raised CPU scheduling priority.}
	{> Process has specified a soft limit on memory requirements and is currently exceeding that limit; such a pro cess is (necessarily) not swapped.}
	{A  Process has asked for random page replacement (VA_ANOM, from vadvise(2),  for example, lisp(1) in a garbage collect).}
	{E The process is trying to exit.}
	{L The process has pages locked in core (for example, for raw I/O).}
	{N The process has reduced CPU scheduling priority (see setpriority(2)).}
	{S The process has asked for FIFO page replacement (VA_SEQL, from vadvise(2),  for example, a large image processing program using virtual memory to sequentially address voluminous data).}
	{s The process is a session leader.}
	{V The process is suspended during a vfork.}
	{W The process is swapped out.}
	{X The process is being traced or debugged.}
}
# get the doc string for a process state character (from ps -o state)
proc lookup_proc_state { header line key } {
  for { set i 0} { $key != [ lindex $header $i ] && \
                     "" != [ lindex $header $i ] } { incr i }  { }
  return [ lindex $line $i ]
}



set PROCESS_FLAGS {
	{SLOAD         0x0000001     in core}
	{SSYS          0x0000002     swapper or pager process}
	{SLOCK         0x0000004     process being swapped out}
	{SSWAP         0x0000008     save area flag}
	{STRC          0x0000010     process is being traced}
	{SWTED         0x0000020     another tracing flag}
	{SSINTR        0x0000040     sleep is interruptible}
	{SPAGE         0x0000080     process in page wait state}
	{SKEEP         0x0000100     another flag to prevent swap out}
	{SOMASK        0x0000200     restore old mask after taking signal}
	{SWEXIT        0x0000400     working on exiting}
	{SPHYSIO       0x0000800     doing physical I/O}
	{SVFORK        0x0001000     process resulted from vfork(2)}
	{SVFDONE       0x0002000     another vfork flag}
	{SNOVM         0x0004000     no vm, parent in a vfork}
	{SPAGV         0x0008000     init data space on demand, from vnode}
	{SSEQL         0x0010000     user warned of sequential vm behavior}
	{SUANOM        0x0020000     user warned of random vm behavior}
	{STIMO         0x0040000     timing out during sleep}
	{SNOCLDSTOP    0x0080000     no SIGCHLD when children stop}
	{SCTTY         0x0100000     has a controlling terminal}
	{SOWEUPC       0x0200000     owe process an addupc() call at next}
	{SSEL          0x0400000     selecting; wakeup/waiting danger}
	{SEXEC         0x0800000     process called exec(2)}
	{SHPUX         0x1000000     HP-UX process (HPUXCOMPAT)}
	{SULOCK        0x2000000     locked in core after swap error}
	{SPTECHG       0x4000000     pte's for process have changed}
}


################################################################
# Define menu bar items
#

# menu bar widget
frame .mbar -bd 2

menubutton .mbar.file -relief raised -text "File" \
		-underline 0 -menu .mbar.file.menu -font $menufont
menubutton .mbar.options -relief raised -text "Options" \
		-underline 0 -menu .mbar.options.menu -font $menufont
menubutton .mbar.signals -relief raised -text "Send Signal" \
		-underline 0 -menu .mbar.signals.menu -font $menufont


menu .mbar.file.menu 
menu .mbar.options.menu 

# a cascaded menu of signals
menu .mbar.signals.menu 
menu .mbar.signals.menu.com_signals -bg lightblue -bd 4 
menu .mbar.signals.menu.all_signals -bg lightblue -bd 4
menu .mbar.signals.menu.posix_signals -bg lightblue -bd 4

################################################################
# Add entries to "Signals" Menu
#
.mbar.signals.menu add cascade -label "Common Signals" \
		-menu .mbar.signals.menu.com_signals -font $menufont

.mbar.signals.menu add cascade -label "POSIX Signals" \
		-menu .mbar.signals.menu.posix_signals -font $menufont

.mbar.signals.menu add cascade -label "All Signals" \
		-menu .mbar.signals.menu.all_signals -font $menufont

################################################################
# Add entries to "File" Menu
#
.mbar.file.menu add command -label "About..." -command { about_box } \
		-font $menufont
.mbar.file.menu add command -label "Quit" -command { exit 0 } \
		-font $menufont

################################################################
# Add entries to "Options" Menu
#

# defaults
set confirm_signals 1
set list_which_signals $common_ps_keywords
#
# a cascaded menu or sort options
menu .mbar.options.menu.sortoptions -bg lightblue -bd 4
.mbar.options.menu.sortoptions add command -label "USER" \
		-font $menufont -command {set sortoption "--sort user" }
.mbar.options.menu.sortoptions add command -label "UID" \
		-font $menufont -command {set sortoption "--sort uid" }
.mbar.options.menu.sortoptions add command -label "%CPU" \
		-font $menufont -command {set sortoption "--sort -pcpu" }
.mbar.options.menu.sortoptions add command -label "PID" \
		-font $menufont -command {set sortoption -Op }

.mbar.options.menu add checkbutton -label "Confirm Signals" \
		-variable confirm_signals -font $menufont
.mbar.options.menu add separator
.mbar.options.menu add radiobutton -label "List Common Process Info" \
		-variable list_which_signals -value $common_ps_keywords -font $menufont
.mbar.options.menu add radiobutton -label "List ALL Process Info" \
		-variable list_which_signals -value $ALL_ps_keywords -font $menufont
.mbar.options.menu add cascade -label "Sort Processes by..." \
		-menu .mbar.options.menu.sortoptions -font $menufont
.mbar.options.menu add separator
.mbar.options.menu add command -label "Set Update Period..." \
		-command "change_update_period" -font $menufont
.mbar.options.menu add command -label "Set 'ps' Command Line Args..." \
		-command "change_ps_args" -font $menufont

################
# Create pull down menu entries for each of the system signals

# add one menu entry for each signal 
proc add_items {menu items} {
    global menufont
    foreach entry $items {
		set signame [lindex $entry 0]
		$menu add command -label $entry \
				-command [list "send_signal" $signame] \
				-font $menufont
    }
}	

add_items .mbar.signals.menu.com_signals $common_sigs
add_items .mbar.signals.menu.all_signals $all_sigs
add_items .mbar.signals.menu.posix_signals $posix_sigs

pack .mbar -side top -fill x -anchor w 

button .mbar.update -relief raised \
		-text "Update" -command { get_unix_procs $greppat} \
		-font $menufont

button .mbar.help -relief raised \
		-text  "Help" -command { help_dialog} \
		-font $menufont

global currenttime

label .mbar.clock -textvariable currenttime \
		-font $menufont

pack .mbar.file  \
		.mbar.options \
		.mbar.signals \
		-side left -anchor w -fill x -ipadx 5m 

pack .mbar.update .mbar.help .mbar.clock -side right

################
tk_menuBar .mbar  .mbar.quit \
		.mbar.options \
		.mbar.com_signals \
		.mbar.posix_signals  \
		.mbar.all_signals 


################################################################
#
# Create an entry field for restricting the visible entries.
# This simulates the "ps auxww | grep foo" idiom. 
#

frame .findbar -bd 2 -relief groove

label .findbar.findlabel -text "Find:" -font $menufont
label .findbar.greplabel -text "Filter:" -font $menufont
entry .findbar.findentry  -width 20 -relief sunken -bd 2 -textvariable findpat
entry .findbar.filterentry -width 20 -relief sunken -bd 2 -textvariable greppat
bind .findbar.filterentry <Return> {update_unix_procs}
bind .findbar.findentry <Return> {find_unix_proc}

pack .findbar.greplabel .findbar.filterentry \
		.findbar.findlabel .findbar.findentry \
		-side left -padx 6m -ipadx 3m

pack .findbar -side top -fill x -anchor w


################################################################
# This runs ps with the (optional) user command line args.
# It fills the listbox with a list of all the processes running,
# using the ps output. 
#
# How do we locate the PID of a process?
#
# We then look through the keyword (header) list to see if we find the PID
# column, and remember which column that is, so we can operate on selected
# processes. Yeesh. After we do 'split' on each line of output, we need
# to eliminate the multiple blanks, and we still are hoping that ps
# doesn't insert a blank between two words in a column. There is no
# direct portable system call which gives basic process information about
# all processes on a machine. There is just 'ps', and we are parsing the
# random text output of a stupid utility program. 
#
# Argh. unix sucks. 
	
label .header -relief groove -anchor w -font $tfont
pack .header -side top -anchor w -fill x

scrollbar .scroll -command ".list yview"
pack .scroll -side right -fill y

wm minsize . 1 1
wm maxsize . 1024 768

listbox .list	-relief groove  -width 100 -height 25 \
		-setgrid yes -font $tfont \
		-yscrollcommand ".scroll set"

pack .list -side top -expand yes -fill both -anchor w


################################################################
# Set up args to 'ps'.
# We either got args from the command line, or we default
# to auxww
 
if {$argc > 0} {
	set ps_args [lindex $argv 0] 
} else {
	set ps_args $DEFAULT_PS_ARGS
}


# This runs ps and gets the results into a list of entries.
# FILTER is a variable used to filter the results, a la grep.  

proc get_unix_procs {filter} {
	global ps_args
	global sortoption
	# The PID column is the column which has the pid numbers in it. 
	# This can change depending on the options passed to 'ps'.
	global pid_column argc argv
	
	# save the old list scroll value 
	set oldyview [.list nearest 0]
	set oldsize [.list size]
	
	# Open a pipe to the "ps" program, with some args.
	set unix_procs_fd  [open "|ps $ps_args $sortoption"] 
	
	# Get the column headers, from the first line of output from ps.
	set header [gets $unix_procs_fd]
	.header config -text $header
	
	set ps_columns [strip_blanks $header]
	set pid_column [lsearch $ps_columns "PID"]
	if { $pid_column < 0 } {
		puts "Couldn't locate the PID column in the output from 'ps' \
				so I can't send a signal to a process:"
		puts $header
		exit 1
	}
	
	# Clear the list items.
	.list delete 0 [.list size ]
	# Fill in listbox with process entries from 'ps' command output.
	while { [set i [gets $unix_procs_fd]] != {}  }  {
		if [regexp $filter $i] {
			.list insert end $i
		}
	}
	
	close $unix_procs_fd
	
	# if the list has not changed size much, try to preserve viewpoint
	if {abs([.list size] - $oldsize) < 2} {
		.list yview $oldyview
	}
	focus .list
}

proc update_unix_procs {} {
	global greppat
	global currenttime
	set currenttime [ exec "date" ]
	get_unix_procs $greppat
}


################################################################
# Finds first entry matching $findpat 
#
# Also scrolls the display to make the item visible if it is not already.

proc find_unix_proc {} {
	global findpat
	set entries [.list size]
	for { set i 0} { $i < $entries } { incr i }  {
		if [regexp $findpat [.list get $i]] {
			.list yview $i
			.list select set $i
		} else {
			.list select clear $i
		}
	}
}

# Set up bindings for the browser.

bind .list <Control-q> {destroy .}
bind .list <Control-c> {destroy .}
bind .list <Button-1> {focus .list}
bind .list <Double-Button-1> {
	set oldconfirm $confirm_signals
	set confirm_signals 1
	foreach i [.list curselection] {show_pinfo}
	set confirm_signals $oldconfirm
}
bind .list <Return> {
	set oldconfirm $confirm_signals
	set confirm_signals 1
	foreach i [.list curselection] {show_pinfo}
	set confirm_signals $oldconfirm
}

bind .list <k> {
	send_signal KILL
}
bind .list <K> {
	send_signal KILL
}

bind .list <n> {
	send_signal INT
}
bind .list <N> {
	send_signal INT
}

bind .list <q> {
	send_signal QUIT
}
bind .list <Q> {
	send_signal QUIT
}

bind .list <i> {
	send_signal IOT
}
bind .list <I> {
	send_signal IOT
}

bind .list <t> {
	send_signal TERM
}
bind .list <T> {
	send_signal TERM
}

bind .list <p> {
	send_signal STOP
}
bind .list <P> {
	send_signal STOP
}

bind .list <h> {
	send_signal HUP
}
bind .list <H> {
	send_signal HUP
}

# Try to make the listbox toggle selections when you click again
#bind .list <Button-1> {
#	set csel  [%W nearest %y] 
#	# Is the selected object already selected?? 
#	if {[lsearch [.list curselection] $csel] != -1} {
#		#If so, clear the selection 
#		.list select clear } else {
#		%W select from $csel
#	}
#}


proc signals_menu {ps_string} {
	global fields
	set fields [strip_blanks [split $ps_string " "]];
	puts $fields   	
}


# Send signal looks at the currently selected entries in the listbox
# and sends the signal to all of them.
proc send_signal {signal} {
	global confirm_signals 
	set pids [selected_processes]
	set proceed 1
	if {$pids != {}} {
		if {$confirm_signals} {set proceed [confirm_dialog $signal $pids]}
		if {$proceed} {
			eval exec [format "kill -%s" $signal] $pids 
		}
		update_unix_procs
	}
}


# get the selected entries from the listbox and extract
# the pid fields from each selection
proc selected_processes {} {
	global pid_column 	
	set z {}
	foreach i [.list curselection] {
		set fields [strip_blanks [split [.list get $i] " "]];
		lappend z [lindex $fields $pid_column]
	}
	return $z
}


# The loop running in the background. 
# We want to make sure that we don't update if there is 
# a current selection in the window.
proc update_loop {} {
	global UPDATE_PERIOD
	if {[.list curselection] == {}} {
		update_unix_procs
	}
    after $UPDATE_PERIOD update_loop
}


################
# The main loop !
update_loop


################################################################
#
# Dialog box for confirmation of kill command 
#
# Returns 1 if proceed, 0 if cancel
#

proc confirm_dialog {signame pids} {
	global val
	set val 1
	# create top level window
	toplevel .confirm -class Dialog
	wm title .confirm "Confirm Kill Command"
	wm iconname .confirm Dialog
	frame .confirm.top -relief raised -bd 1
	pack .confirm.top -side top -fill both
	frame .confirm.bot -relief raised -bd 1
	pack .confirm.bot -side bottom -fill both
	
	message .confirm.top.msg -width 3i \
			-text "Send $signame to processes $pids ?" \
			-font -Adobe-helvetica-medium-r-normal--*-120-* -aspect 200 
	pack .confirm.top.msg -side right -expand yes -fill both -padx 3m -pady 3m
	
	label .confirm.top.bitmap  -bitmap warning 
	pack  .confirm.top.bitmap  -side left -padx 3m -pady 3m
	
	frame .confirm.bot.default -relief sunken -bd 1
	raise .confirm.bot.default
	pack .confirm.bot.default -side left -expand yes -padx 3m -pady 2m
	
	button .confirm.bot.ok  -text "OK" \
			-command {set val 1}
	pack  .confirm.bot.ok -in .confirm.bot.default \
			-side left -padx 2m -pady 2m \
			-ipadx 2m -ipady 1m
	
	button .confirm.bot.cancel -text "Cancel" \
			-command {set val 0}
	pack .confirm.bot.cancel -side left -expand yes \
			-padx 3m -pady 2m -ipadx 2m -ipady 1m
	
	bind .confirm <Escape> "destroy .confirm"
	bind .confirm.bot.ok <Return> ".confirm.bot.ok flash; set val 1"
	bind .confirm.bot.cancel <Return> ".confirm.bot.cancel flash; set val 0"
	bind .confirm <o> ".confirm.bot.ok flash; set val 1"
	bind .confirm <O> ".confirm.bot.ok flash; set val 1"
	bind .confirm <c> ".confirm.bot.cancel flash; set val 0"
	bind .confirm <C> ".confirm.bot.cancel flash; set val 0"

	focus .confirm.bot.ok
	grab .confirm
	tkwait variable val
	grab release .confirm
	destroy .confirm

	return $val
}

   
################################################################
proc msg_dialog {msg} {
	toplevel .helpwin
	wm title .helpwin Help

	message .helpwin.msg -text $msg \
		 -font -Adobe-helvetica-medium-r-normal--*-120-* -aspect 200

	frame .helpwin.default -relief sunken -bd 1
	raise .helpwin.default

	button .helpwin.ok -text Ok -pady 3 -command { destroy .helpwin }
	pack .helpwin.msg -side top
	pack .helpwin.ok -side top -in .helpwin.default -padx 1m -pady 1m
	pack .helpwin.default

	bind .helpwin <Escape> "destroy .helpwin"
	bind .helpwin <Return> ".helpwin.ok flash; .helpwin.ok invoke"
}


proc help_dialog {} {
  msg_dialog {This program will send a signal to the selected process. There \
are several equivalent ways to choose a signal to send. \

First, select a process from the list below, then select a signal to send to \
it, either using a button on the bottom of the window, or from one of the \
signal menus. The commonly used signals have their own buttons along the \
bottom of the window. 

It can be used shotcut key, `k' as KILL, `n' as INT, `q' as QUIT, \
`i' as IOT, `t' as TERM, `p' as STOP, `h' as HUP signal.

The signal menus contain the following (redundant) sets of signals:
 Common_Signals contains commonly used signals. 
 POSIX_Signals contains POSIX standard signals.
 All_signals contains all signals available. 

The "Filter" text entry field is essentially equivalent to "ps auxww | grep foo" for some value of foo. 

The "Find" entry box lets you select the first process matching the entry foo. 

The Options menu contains some configuration settings.
 "Confirm"  will pop up a dialog before executing a kill command.
 "List Common Process Info": double click on process pops up dialog of common useful process info.
 "List ALL Process Info": double click on process pops up dialog of ALL process info available through ps.
 "Set Update Period" adjusts the time between updating the display (and running "ps" again, which is expensive for some reason. 
 "Set Command Line Args" sets the option string which is sent to ps. It defaults to "auxww" }

}

proc about_box {} {
	msg_dialog {The tkps browser was written by 
Ed Petron (epetron@leba.net)
Kidong Lee (kidong@shinbiro.com)

Originally written by Henry Minsky (hqm@ai.mit.edu)
	
This is Version 1.15, August 2001

Terms of the GNU Public License apply.
}
}


################################################################
# This ought to be a generic program to change a variable's value
proc change_update_period {} {
	global UPDATE_PERIOD MIN_UPDATE_PERIOD menufont update_time
	global prompt
	set prev_update_time $UPDATE_PERIOD
	set update_time $UPDATE_PERIOD
	catch {destroy .update}
	# create top level window
	toplevel .update -class Dialog
	wm title .update "Set Update Period"
	wm iconname .update Dialog
	frame .update.bot -relief raised -bd 1
	frame .update.top -relief raised -bd 1
	pack .update.top -side top -fill both
	pack .update.bot -side bottom -fill both
	
	button .update.bot.ok -relief raised -text "Ok" \
			-command {set prompt 1} -font $menufont
	button .update.bot.cancel -text "Cancel" \
			-command {set prompt 0} -font $menufont

	pack .update.bot.ok -side left -expand yes
	pack .update.bot.cancel -side right -expand yes
	
	label .update.top.label -text "Update period (ms):"
	entry .update.top.val  -width 15 -justify right -relief sunken \
			-bd 2 -textvariable update_time
	
	pack .update.top.label .update.top.val \
			-side top -padx 3m -ipadx 3m
	
	bind .update.top.val <Return> "set prompt 1"
	bind .update.bot.ok <Return> "set prompt 1"
	bind .update.bot.cancel <Return> "set prompt 0"

	bind .update <Escape> "set prompt 0"

	focus .update.top.val
	grab .update
	tkwait variable prompt
	grab release .update
	destroy .update

	# Don't let the updates go too fast.
	if {$prompt} {
		if {$update_time < $MIN_UPDATE_PERIOD} {
			set UPDATE_PERIOD $MIN_UPDATE_PERIOD
		} else {
			set UPDATE_PERIOD $update_time
		}
	} else {
		set UPDATE_PERIOD $prev_update_time
	}

}

################################################################
# Dialog to change args to ps. This should call a dialog subroutine.
#
proc change_ps_args {} {
	global ps_args args menufont DEFAULT_PS_ARGS
	global prompt
	catch {destroy .args}
	set args $ps_args
	set prev_ps_args $ps_args
	# create top level window
	toplevel .args -class Dialog
	wm title .args "Set Command Line Args"
	wm iconname .args Dialog
	frame .args.bot -relief raised -bd 1
	frame .args.top -relief raised -bd 1
	pack .args.top -side top -fill both
	pack .args.bot -side bottom -fill both
	
	button .args.bot.ok -relief raised \
			-text "Ok" -command {set prompt 1} -font $menufont
	button .args.bot.cancel -relief raised \
			-text "Cancel" -command {set prompt 0} -font $menufont
	
	pack .args.bot.ok -side left -expand yes
	pack .args.bot.cancel -side right -expand yes

	label .args.top.label -text "Command Line Args To \"ps\":"
	entry .args.top.val  -width 20 -relief sunken \
			-bd 2 -textvariable args
	
	pack .args.top.label .args.top.val \
			-side top -padx 3m -ipadx 3m
	
	bind .args.top.val <Return> "set prompt 1"
	bind .args.bot.ok <Return> "set prompt 1"
	bind .args.bot.cancel <Return> "set prompt 0"

	bind .args.top.val <Escape> "set prompt 0"

	set oldFocus [focus]
	
	focus .args.top.val
	grab .args
	tkwait variable prompt
	grab release .args
	destroy .args

	# Don't let the updates go too fast.
	if {$prompt} {
		if {$args != ""} {
			set ps_args $args
		} else {
			set ps_args $DEFAULT_PS_ARGS
		}
	} else {
		set ps_args $prev_ps_args
	}

	update_unix_procs
}

# runs 'man' on the NAME given, and puts the output
# in a text widget 
proc manpage {name} {	
	text .text -releif raised -bd 2 \
			-yscrollcommand ".scrolltext set"
	scrollbar .scrolltext -command ".text yview"
}

################################################################
# Routines to display a popup text widget with detailed info on a process


# Makes a comma separated list of the first item in each list
# in a list of lists.
proc first_items {l} {
	set z {}
	foreach i $l {
		set keyword [lindex $i 0];
		set z [lappend z $keyword];
	}
	return [join $z ","];
}

proc fill_info_window {pid widget} {
	$widget configure -state normal
	$widget delete 1.0 end
	$widget insert end [ exec /usr/share/tkps/pidinfo $pid ]
	$widget insert end "\n"
	set proc_fd [ open "|ps aux -p $pid" ]
	gets $proc_fd ps_header
	gets $proc_fd ps_line
	close $proc_fd
	set user [ lookup_proc_state $ps_header $ps_line USER ]
	set cpu [ lookup_proc_state $ps_header $ps_line %CPU ]
	set mem [ lookup_proc_state $ps_header $ps_line %MEM ]
	$widget insert end [ format "User:   %s\n" $user ]
	$widget insert end [ format "CPU%s:   %s\n" "%" $cpu ]
	$widget insert end [ format "MEM%s:   %s\n" "%" $mem ]
	
	$widget insert end [ exec /usr/share/tkps/meminfo $pid ]
	$widget insert end "\n\n"
	$widget insert end [ exec /usr/share/tkps/signals $pid ]
	$widget configure -state disabled
}

proc show_pinfo {} {
	set sp [selected_processes]
	foreach p $sp { 
    show_detailed_proc $p
	}
}

proc get_family_info {pid} {
	set faminfo ""
	set f [ open "|/usr/share/tkps/family $pid " ]
	set faminfo [ gets $f ]
	set faminfo [ format "%s %s" $faminfo [ gets $f ] ]
	close $f
	return [ split $faminfo ]
}

proc build_child_list {plist widget} {
	$widget delete 0 end
	foreach p [ lrange $plist 1 end ] {
		$widget insert end $p
	}
}

proc show_child_detail { widget } {
	set s [ $widget curselection ] 
	set p [ $widget get $s ]
	show_detailed_proc $p
}

proc show_detailed_proc {pid} {
	global menufont 
	set P .pinfo$pid
	set TOP $P.top
	set family [ get_family_info $pid ]
	# create top level window
	set error [ catch { toplevel $P -class Dialog } ]
	if { $error != 0 } then {
		raise $P
		focus $P
		fill_info_window $pid $TOP.pid.frame.text
		set ppid [ lrange $family 0 0 ]
		$TOP.fam.parent.button configure -text $ppid
		build_child_list $family $TOP.fam.children.list
		return
	}
	frame $TOP
	frame $TOP.pid 
	frame $TOP.pid.frame
	frame $TOP.fam 
	label $TOP.pid.label -text "Process"
	label $TOP.fam.label -text "Family"
	frame $TOP.fam.parent 
	label $TOP.fam.parent.label -text "Parent PID: "
	frame $TOP.fam.children 
	label $TOP.fam.children.label -text "Children: "
	listbox $TOP.fam.children.list -height 10 -width 5 \
			-yscrollcommand "$TOP.fam.children.scroll set"
	scrollbar $TOP.fam.children.scroll -command "$TOP.fam.children.list yview"
	scrollbar $TOP.pid.scroll -command "$TOP.pid.text yview"
	set ppid [ lrange $family 0 0 ]
	button $TOP.fam.parent.button -text $ppid
	pack $TOP -side top -fill both
	pack $TOP.pid -side left -fill both 
	pack $TOP.pid.label $TOP.pid.frame -side top -fill x
	pack $TOP.fam -side left -fill both
	pack $TOP.fam.label -side top 
	pack $TOP.fam.parent -side top
	pack $TOP.fam.children -side top
	pack $TOP.fam.children.label $TOP.fam.children.list -side left
	pack $TOP.fam.children.scroll -side left -fill y
	pack $TOP.fam.parent.label $TOP.fam.parent.button -side left 
	build_child_list $family $TOP.fam.children.list
	frame $P.bot -relief raised -bd 1
	pack $P.bot -side bottom -fill both
	
	# text widget for process info strings
	text $TOP.pid.frame.text -width 30 \
			-yscrollcommand "$TOP.pid.frame.scroll set"
	scrollbar $TOP.pid.frame.scroll -command "$TOP.pid.frame.text yview"
	
	fill_info_window $pid $TOP.pid.frame.text
	
	pack $TOP.pid.frame.text $TOP.pid.frame.scroll -side left -fill y 
	
	wm title $P "Process $pid Info"
	wm iconname $P "PID $pid"
	
	frame $P.bot.default -relief sunken
	raise $P.bot.default
	
	button $P.bot.ok  -text "Dismiss" -relief raised\
			-command  [list "destroy" $P] -font $menufont 
	button $P.bot.kill  -text "Kill Process" -relief raised\
			-command  [list "exec" "kill" "-KILL" $pid] -font $menufont
	
	pack  $P.bot.ok -in $P.bot.default \
			-side left -padx 2m -pady 2m \
			-ipadx 2m -ipady 1m
	
	pack $P.bot.default $P.bot.kill -side left -expand yes \
			-padx 3m -pady 2m  -ipadx 2m -ipady 1m
	
	bind $P <Return> "$P.bot.ok flash; set val 1"
	bind $TOP.fam.parent.button <ButtonPress> "show_detailed_proc $ppid"
	bind $TOP.fam.children.list <Double-ButtonPress> \
			"show_child_detail $TOP.fam.children.list"

	focus $P.bot.ok
	grab $P
	grab release $P
	
	bind $P <Escape> "destroy $P"
	bind $P.bot.ok <Return> "$P.bot.ok flash; $P.bot.ok invoke"
	bind $P.bot.kill <Return> "$P.bot.kill flash; $P.bot.kill invoke"
	bind $P <d> "$P.bot.ok flash; $P.bot.ok invoke"
	bind $P <D> "$P.bot.ok flash; $P.bot.ok invoke"
	bind $P <k> "$P.bot.kill flash; $P.bot.kill invoke"
	bind $P <K> "$P.bot.kill flash; $P.bot.kill invoke"
}
