home *** CD-ROM | disk | FTP | other *** search
/ ftp.muug.mb.ca / 2014.06.ftp.muug.mb.ca.tar / ftp.muug.mb.ca / pub / src / tcl / examples / tkps < prev    next >
Text File  |  1994-11-02  |  37KB  |  1,117 lines

  1. #!/usr/local/bin/wish -f
  2. #
  3. # This script generates a process browser, which lists the running
  4. # processes (using unix "ps") and allows you to send signals (such as KILL)
  5. # using a popup menu. 
  6.  
  7. # Create a scrollbar on the right side of the main window and a listbox
  8. # on the left side.
  9. #
  10. # Henry Minsky (hqm@ai.mit.edu)  May 1994
  11. #
  12. proc strip_blanks { str} {
  13.    set tmpstr "" ;
  14.    foreach i $str {
  15.      if {$i != ""} { lappend tmpstr $i }
  16.    }
  17.    return $tmpstr
  18. }
  19.  
  20. ################################################################
  21. # Default settings
  22.  
  23. set menufont "-Adobe-helvetica-bold-r-normal--*-120-*"
  24. set tfont "fixed"
  25.  
  26. wm title . "Running Processes"
  27.  
  28. # The default update time of display is 10 seconds
  29. # You can change it in the configure menu.
  30. set MIN_UPDATE_PERIOD 2000
  31. set UPDATE_PERIOD 10000 
  32.  
  33. # The default double click behavior
  34. set USER_SIG KILL
  35.  
  36. # The default command line args to "ps"
  37. set DEFAULT_PS_ARGS  "-auxww"
  38.  
  39. ################################################################
  40. # You can get the implementation dependent signal names for your system
  41. # from /usr/include/signal.h
  42.  
  43. set common_sigs {
  44. {INT    2       interupt}
  45. {QUIT   3       quit}
  46. {IOT    6       abort}
  47. {KILL   9       non-catchable, non-ignorable kill}
  48. {STOP   17      sendable stop signal not from tty}
  49. {ALRM   14      alarm clock}
  50. {TERM   15      software termination signal}
  51. }
  52.  
  53.  
  54.  
  55. # Make a button bar for the common signals
  56. frame .bbar
  57. button .bbar.kill -text KILL -command { send_signal KILL } -font $menufont
  58. button .bbar.int -text INT -command { send_signal INT } -font $menufont
  59. button .bbar.quit -text QUIT -command { send_signal QUIT } -font $menufont
  60. button .bbar.iot -text IOT -command { send_signal IOT } -font $menufont
  61. button .bbar.term -text TERM -command { send_signal TERM } -font $menufont
  62. button .bbar.stop -text STOP -command { send_signal STOP } -font $menufont
  63. button .bbar.hup -text HUP -command { send_signal HUP } -font $menufont
  64.  
  65. pack .bbar.kill  .bbar.int .bbar.quit \
  66.      .bbar.iot .bbar.term .bbar.stop .bbar.hup \
  67.      -side left -padx 3m -ipadx 6m -pady 3m
  68.  
  69. pack .bbar  -side bottom -expand yes -fill x -anchor w
  70.  
  71. set all_sigs {
  72. {HUP    1       hangup}
  73. {INT    2       interrupt}
  74. {QUIT   3       quit}
  75. {ILL    4       illegal instruction (not reset when caught)}
  76. {TRAP   5       trace trap (not reset when caught)}
  77. {ABRT   6       abort()}
  78. {IOT    SIGABRT compatibility}
  79. {EMT    7       EMT instruction}
  80. {FPE    8       floating point exception}
  81. {KILL   9       kill (cannot be caught or ignored)}
  82. {BUS    10      bus error}
  83. {SEGV   11      segmentation violation}
  84. {SYS    12      bad argument to system call}
  85. {PIPE   13      write on a pipe with no one to read it}
  86. {ALRM   14      alarm clock}
  87. {TERM   15      software termination signal from kill}
  88. {URG    16      urgent condition on IO channel}
  89. {STOP   17      sendable stop signal not from tty}
  90. {TSTP   18      stop signal from tty}
  91. {CONT   19      continue a stopped process}
  92. {CHLD   20      to parent on child stop or exit}
  93. {TTIN   21      to readers pgrp upon background tty read}
  94. {TTOU   22      like TTIN for output if (tp->t_local<OSTOP)}
  95. {IO     23      input/output possible signal}
  96. {XCPU   24      exceeded CPU time limit}
  97. {XFSZ   25      exceeded file size limit}
  98. {VTALRM 26      virtual time alarm}
  99. {PROF   27      profiling time alarm}
  100. {WINCH 28       window size changes}
  101. {INFO   29      information request}
  102. {USR1 30        user defined signal 1}
  103. {USR2 31        user defined signal 2}
  104.  
  105. }
  106.  
  107. set posix_sigs {
  108.  
  109. {HUP    1       hangup}
  110. {INT    2       interrupt}
  111. {QUIT   3       quit}
  112. {ILL    4       illegal instruction (not reset when caught)}
  113. {ABRT   6       abort()}
  114. {FPE    8       floating point exception}
  115. {KILL   9       kill (cannot be caught or ignored)}
  116. {SEGV   11      segmentation violation}
  117. {PIPE   13      write on a pipe with no one to read it}
  118. {ALRM   14      alarm clock}
  119. {TERM   15      software termination signal from kill}
  120. {STOP   17      sendable stop signal not from tty}
  121. {TSTP   18      stop signal from tty}
  122. {CONT   19      continue a stopped process}
  123. {CHLD   20      to parent on child stop or exit}
  124. {TTIN   21      to readers pgrp upon background tty read}
  125. {TTOU   22      like TTIN for output if (tp->t_local<OSTOP)}
  126. {USR1 30        user defined signal 1}
  127. {USR2 31        user defined signal 2}
  128. }
  129.  
  130. ################################################################
  131.  
  132. set common_ps_keywords {
  133.         {%cpu       percentage cpu usage (alias pcpu)}
  134.         {%mem       percentage memory usage (alias pmem)}
  135.         {uid        effective user ID}
  136.         {user       user name (from uid)}
  137.         {majflt     total page faults}
  138.         {minflt     total page reclaims}
  139.         {msgrcv     total messages received (reads from pipes/sockets)}
  140.         {msgsnd     total messages sent (writes on pipes/sockets)}
  141.         {vsz        virtual size in Kbytes (alias vsize)}
  142.         {nice       nice value (alias ni)}
  143.         {nsigs      total signals taken (alias nsignals)}
  144.         {nswap      total swaps in/out}
  145.         {pgid       process group number}
  146.         {pid        process ID}
  147.         {ppid       parent process ID}
  148.         {rgid       real group ID}
  149.         {ruid       real user ID}
  150.         {ruser      user name (from ruid)}
  151.         {start      time started}
  152.         {time       accumulated cpu time, user + system (alias cputime)}
  153.         {tpgid      control terminal process group ID}
  154.         {tsiz       text size (in Kbytes)}
  155.         {tty        full name of control terminal}
  156.         {lim        memoryuse limit}
  157.         {logname    login name of user who started the process}
  158. }
  159.  
  160. set ALL_ps_keywords {
  161.         {%cpu       percentage cpu usage (alias pcpu)}
  162.         {%mem       percentage memory usage (alias pmem)}
  163.         {acflag     accounting flag (alias acflg)}
  164.         {cpu        short-term cpu usage factor (for scheduling)}
  165.         {inblk      total blocks read (alias inblock)}
  166.         {jobc       job control count}
  167.         {ktrace     tracing flags}
  168.         {ktracep    tracing vnode}
  169.         {lim        memoryuse limit}
  170.         {lstart     time started}
  171.         {majflt     total page faults}
  172.         {minflt     total page reclaims}
  173.         {msgrcv     total messages received (reads from pipes/sockets)}
  174.         {msgsnd     total messages sent (writes on pipes/sockets)}
  175.         {nice       nice value (alias ni)}
  176.         {nivcsw     total involuntary context switches}
  177.         {nsigs      total signals taken (alias nsignals)}
  178.         {nswap      total swaps in/out}
  179.         {nvcsw      total voluntary context switches}
  180.         {nwchan     wait channel (as an address)}
  181.         {oublk      total blocks written (alias oublock)}
  182.         {p_ru       resource usage (valid only for zombie)}
  183.         {paddr      swap address}
  184.         {pagein     pageins (same as majflt)}
  185.         {pgid       process group number}
  186.         {pid        process ID}
  187.         {ppid       parent process ID}
  188.         {pri        scheduling priority}
  189.         {re         core residency time (in seconds; 127 = infinity)}
  190.         {rgid       real group ID}
  191.  
  192.         {rlink      reverse link on run queue, or 0}
  193.         {rss        resident set size}
  194.         {rsz        resident set size + (text size / text use count) (alias rs- size)}
  195.         {ruid       real user ID}
  196.         {ruser      user name (from ruid)}
  197.         {sess       session pointer}
  198.         {sig        pending signals (alias pending)}
  199.         {sigcatch   caught signals (alias caught)}
  200.         {sigignore  ignored signals (alias ignored)}
  201.         {sigmask    blocked signals (alias blocked)}
  202.         {sl         sleep time (in seconds; 127 = infinity)}
  203.         {start      time started}
  204.         {svgid      saved gid from a setgid executable}
  205.         {svuid      saved uid from a setuid executable}
  206.         {tdev       control terminal device number}
  207.         {time       accumulated cpu time, user + system (alias cputime)}
  208.         {tpgid      control terminal process group ID}
  209.         {tsess      control terminal session pointer}
  210.         {tsiz       text size (in Kbytes)}
  211.         {tt         control terminal name (two letter abbreviation)}
  212.         {tty        full name of control terminal}
  213.         {ucomm      name to be used for accounting}
  214.         {uid        effective user ID}
  215.         {upr        scheduling priority on return from system call (alias usrpri)}
  216.         {user       user name (from uid)}
  217.         {vsz        virtual size in Kbytes (alias vsize)}
  218.         {wchan      wait channel (as a symbolic name)}
  219.         {xstat      exit or stop status (valid only for stopped or zombie process)}
  220.         {logname    login name of user who started the process}
  221.  
  222. }
  223.  
  224. set state_fields {
  225.  {D Process in disk (or other short term, uninterruptable) wait.}
  226.  {I Process that is idle (sleeping for longer than about 20 seconds).}
  227.  {P Process in page wait.}
  228.  {R Process is Runnable.}
  229.  {S Process is sleeping for less than about 20 seconds.}
  230.  {T Process is stopped.}
  231.  {Z Process is dead (a ``zombie'').}
  232.  {+ Process is in the foreground process group of its control terminal.}
  233.  {< Process has raised CPU scheduling priority.}
  234.  {> Process has specified a soft limit on memory requirements and is currently exceeding that limit; such a pro cess is (necessarily) not swapped.}
  235.  {A  Process has asked for random page replacement (VA_ANOM, from vadvise(2),  for example, lisp(1) in a garbage collect).}
  236.  {E The process is trying to exit.}
  237.  {L The process has pages locked in core (for example, for raw I/O).}
  238.  {N The process has reduced CPU scheduling priority (see setpriority(2)).}
  239.  {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).}
  240.  {s The process is a session leader.}
  241.  {V The process is suspended during a vfork.}
  242.  {W The process is swapped out.}
  243.  {X The process is being traced or debugged.}
  244. }
  245. # get the doc string for a process state character (from ps -o state)
  246. proc lookup_proc_state {char} {
  247.   global state_fields
  248.   foreach entry $state_fields {
  249.         if {$char == [string index $entry 0]} {
  250.                 return $entry;
  251.         }
  252.   }
  253.   return {}
  254. }
  255.  
  256.   
  257.  
  258.  
  259. set PROCESS_FLAGS {
  260.  {SLOAD         0x0000001     in core}
  261.  {SSYS          0x0000002     swapper or pager process}
  262.  {SLOCK         0x0000004     process being swapped out}
  263.  {SSWAP         0x0000008     save area flag}
  264.  {STRC          0x0000010     process is being traced}
  265.  {SWTED         0x0000020     another tracing flag}
  266.  {SSINTR        0x0000040     sleep is interruptible}
  267.  {SPAGE         0x0000080     process in page wait state}
  268.  {SKEEP         0x0000100     another flag to prevent swap out}
  269.  {SOMASK        0x0000200     restore old mask after taking signal}
  270.  {SWEXIT        0x0000400     working on exiting}
  271.  {SPHYSIO       0x0000800     doing physical I/O}
  272.  {SVFORK        0x0001000     process resulted from vfork(2)}
  273.  {SVFDONE       0x0002000     another vfork flag}
  274.  {SNOVM         0x0004000     no vm, parent in a vfork}
  275.  {SPAGV         0x0008000     init data space on demand, from vnode}
  276.  {SSEQL         0x0010000     user warned of sequential vm behavior}
  277.  {SUANOM        0x0020000     user warned of random vm behavior}
  278.  {STIMO         0x0040000     timing out during sleep}
  279.  {SNOCLDSTOP    0x0080000     no SIGCHLD when children stop}
  280.  {SCTTY         0x0100000     has a controlling terminal}
  281.  {SOWEUPC       0x0200000     owe process an addupc() call at next}
  282.  {SSEL          0x0400000     selecting; wakeup/waiting danger}
  283.  {SEXEC         0x0800000     process called exec(2)}
  284.  {SHPUX         0x1000000     HP-UX process (HPUXCOMPAT)}
  285.  {SULOCK        0x2000000     locked in core after swap error}
  286.  {SPTECHG       0x4000000     pte's for process have changed}
  287. }
  288.  
  289.  
  290.  
  291.  
  292. ################################################################
  293. # Define menu bar items
  294. #
  295.  
  296. # menu bar widget
  297. frame .mbar -bd 2
  298.  
  299. menubutton .mbar.file -relief raised -text "File" \
  300.                  -underline 0 -menu .mbar.file.menu -font $menufont
  301. menubutton .mbar.options -relief raised -text "Options" \
  302.                  -underline 0 -menu .mbar.options.menu -font $menufont
  303. menubutton .mbar.signals -relief raised -text "Send Signal" \
  304.                  -underline 0 -menu .mbar.signals.menu -font $menufont
  305.  
  306.  
  307. menu .mbar.file.menu 
  308. menu .mbar.options.menu 
  309.  
  310. # a cascaded menu of signals
  311. menu .mbar.signals.menu 
  312. menu .mbar.signals.menu.com_signals -bg lightblue -bd 4 
  313. menu .mbar.signals.menu.all_signals -bg lightblue -bd 4
  314. menu .mbar.signals.menu.posix_signals -bg lightblue -bd 4
  315.  
  316.  
  317. ################################################################
  318. # Add entries to "Signals" Menu
  319. #
  320. .mbar.signals.menu add cascade -label "Common Signals" \
  321.         -menu .mbar.signals.menu.com_signals -font $menufont
  322.  
  323. .mbar.signals.menu add cascade -label "POSIX Signals" \
  324.         -menu .mbar.signals.menu.posix_signals -font $menufont
  325.  
  326. .mbar.signals.menu add cascade -label "All Signals" \
  327.         -menu .mbar.signals.menu.all_signals -font $menufont
  328.  
  329. ################################################################
  330. # Add entries to "File" Menu
  331. #
  332. .mbar.file.menu add command -label "About" -command { about_box } \
  333.         -font $menufont
  334. .mbar.file.menu add command -label "Quit" -command { exit 0 } \
  335.         -font $menufont
  336.  
  337. ################################################################
  338. # Add entries to "Options" Menu
  339. #
  340.  
  341. # defaults
  342. set confirm_signals 1
  343. set list_which_signals $common_ps_keywords
  344. #
  345. .mbar.options.menu add checkbutton -label "Confirm Signals" \
  346.         -variable confirm_signals -font $menufont
  347. .mbar.options.menu add separator
  348. .mbar.options.menu add radiobutton -label "List Common Process Info" \
  349.         -variable list_which_signals -value $common_ps_keywords -font $menufont
  350. .mbar.options.menu add radiobutton -label "List ALL Process Info" \
  351.         -variable list_which_signals -value $ALL_ps_keywords -font $menufont
  352. .mbar.options.menu add separator
  353. .mbar.options.menu add command -label "Set Update Period..." \
  354.         -command "change_update_period" -font $menufont
  355. .mbar.options.menu add command -label "Set 'ps' Command Line Args..." \
  356.         -command "change_ps_args" -font $menufont
  357.  
  358. ################
  359. # Create pull down menu entries for each of the system signals
  360.  
  361. # add one menu entry for each signal 
  362. proc add_items {menu items} {
  363.     global menufont
  364.     foreach entry $items {
  365.        set signame [lindex $entry 0]
  366.        $menu add command -label $entry \
  367.                   -command [list "send_signal" $signame] \
  368.                 -font $menufont
  369.     }
  370. }       
  371.  
  372. add_items .mbar.signals.menu.com_signals $common_sigs
  373. add_items .mbar.signals.menu.all_signals $all_sigs
  374. add_items .mbar.signals.menu.posix_signals $posix_sigs
  375.  
  376. pack .mbar -side top -fill x -anchor w 
  377.  
  378. button .mbar.update -relief raised \
  379.         -text  "Update" -command { get_unix_procs $greppat} \
  380.         -font $menufont
  381.  
  382. button .mbar.help -relief raised \
  383.         -text  "Help" -command { help_dialog} \
  384.         -font $menufont
  385.  
  386. pack  .mbar.file  \
  387.       .mbar.options \
  388.       .mbar.signals \
  389.        -side left -anchor w -fill x -ipadx 5m 
  390.  
  391. pack .mbar.update .mbar.help -side right
  392.  
  393. ################
  394. tk_menuBar .mbar  .mbar.quit \
  395.                   .mbar.options \
  396.                   .mbar.com_signals \
  397.                   .mbar.posix_signals  \
  398.                   .mbar.all_signals 
  399.  
  400.  
  401.  
  402. ################################################################
  403. #
  404. # Create an entry field for restricting the visible entries.
  405. # This simulates the "ps auxww | grep foo" idiom. 
  406. #
  407.  
  408. frame .findbar -bd 2 -relief groove
  409.  
  410. label .findbar.findlabel -text "Find:" -font $menufont
  411. label .findbar.greplabel -text "Filter:" -font $menufont
  412. entry .findbar.findentry  -width 20 -relief sunken -bd 2 -textvariable findpat
  413. entry .findbar.filterentry -width 20 -relief sunken -bd 2 -textvariable greppat
  414. bind .findbar.filterentry <Return> {update_unix_procs}
  415. bind .findbar.findentry <Return> {find_unix_proc}
  416.  
  417.  
  418. pack .findbar.greplabel .findbar.filterentry \
  419.      .findbar.findlabel .findbar.findentry \
  420.       -side left -padx 6m -ipadx 3m
  421.  
  422. pack .findbar -side top -fill x -anchor w
  423.  
  424. ############ Listbox scrolling functions ################
  425. #
  426. # These functions (LBscroll_sb & LBscroll_drag) vastly improve
  427. # the action of listboxes when they are scrolled around.  Out of
  428. # the box TK lets you drag the listbox down to a point where there's
  429. # only one item at the top of the screen, whereas it is more normal
  430. # and better UI design to drag only to where the last item in the
  431. # listbox is at the bottom (rather than the top).
  432. #
  433. # These functions implement this policy.  They do this by calculating
  434. # where the window needs to end up.
  435. #
  436. #
  437. # [ listbox code from David Herron <david@twg.com> ]
  438. #
  439. # LBscroll_sb list scrollbar which total window first last
  440. #
  441. #       This is to scroll the list by means of the scrollbar.
  442. #       This is meant to be used as so:
  443. #
  444. #               listbox .lb     -relief sunken \
  445. #                       -yscrollcommand "LBscroll_sb .lb .vs y" \
  446. #                       -xscrollcommand "LBscroll_sb .lb .hs x"
  447. #
  448. #       list:   The listbox widget
  449. #
  450. #       scrollbar: The relavent scrollbar widget
  451. #
  452. #       which:  Either `x' or `y' and is used to
  453. #               generate the `yview' or `xview'
  454. #               subcommand.
  455. #
  456. #       total, window, first, last: Provided
  457. #               by the listbox widget.
  458. #
  459. # LBscroll_kb listbox which
  460. #
  461. #       Scrolls by the keyboard.  This is used when keyboard
  462. #       focus has traversed to the listbox.  Out of the box
  463. #       TK does not support this, but should as it is a normal
  464. #       part of Motif and TK is moving very strongly to the
  465. #       Motif L&F.
  466. #
  467. #       It is meant to be used as so:
  468. #
  469. #               bind .lb <Key-Up>   "LBscroll_kb %W Up"
  470. #               bind .lb <Key-Down> "LBscroll_kb %W Down"
  471. #               bind .lb <Key-F27>  "LBscroll_kb %W Home"
  472. #               bind .lb <Key-F29>  "LBscroll_kb %W PgUp"
  473. #               bind .lb <Key-F35>  "LBscroll_kb %W PgDn"
  474. #               bind .lb <Key-R13>  "LBscroll_kb %W End"
  475. #
  476. #       The F27/F29/F35/R13 are generated by my Sun type 4
  477. #       keyboard while running MIT X11R5 (pl19?).  I've seen
  478. #       other keysyms generated from other keyboards.  The
  479. #       ShowKey function below is useful in determining what
  480. #       the keysyms are on your keyboard (as TK sees them).
  481. #
  482. # LBbindScroll listbox
  483. #
  484. #       Sets up bindings as described for LBscroll_kb.
  485. #
  486.  
  487. proc LBscroll_sb {list sb which total window first last} {
  488.         if {[expr $first+$window] > $total} {
  489.                 set first [expr $total-$window]
  490.                 set last  [expr $first+$window]
  491.         }
  492.         $list ${which}view $first
  493.         $sb set $total $window $first $last
  494. }
  495.  
  496. proc LBscroll_kb {lb which} {
  497.  
  498.         set cur  [$lb nearest 0]
  499.         set last [$lb nearest [winfo height $lb]]
  500.         set sz   [$lb size]
  501.         set disp [expr "($last - $cur) + 1"]
  502.  
  503.         switch -- $which {
  504.         Up      {
  505.                 set cur [expr "$cur <= 0 ? $cur : $cur - 1"]
  506.                 $lb yview $cur
  507.                 }
  508.         Down    {
  509.                 incr cur
  510.                 set newend [expr "$cur + $disp"]
  511.                 if {$newend >= $sz} { set cur [expr "$sz - $disp"] }
  512.                 $lb yview $cur
  513.                 }
  514.         PgUp    {
  515.                 incr cur "-$disp"
  516.                 if {$cur < 0} {set cur 0}
  517.                 $lb yview $cur
  518.                 }
  519.         PgDn    {
  520.                 incr cur $disp
  521.                 set newend [expr "$cur + $disp"]
  522.                 if {$newend > $sz} { set cur [expr "$sz - $disp"] }
  523.                 $lb yview $cur
  524.                 }
  525.         Home    {
  526.                 $lb yview 0
  527.                 }
  528.         End     {
  529.                 set cur  [expr "$sz - $disp"]
  530.                 $lb yview $cur
  531.                 }
  532.         default {
  533.                 error "Unknown scroll request '$lb $which'." \
  534.                         "" \
  535.                         [list PWMERROR "" -toplevel $lb.error]
  536.                 }
  537.         }
  538. }
  539.  
  540. proc LBbindScroll {} {
  541.         bind Listbox <Up>   "LBscroll_kb %W Up"
  542.         bind Listbox <Down> "LBscroll_kb %W Down"
  543.         bind Listbox <Home>  "LBscroll_kb %W Home"
  544.         bind Listbox <Prior>  "LBscroll_kb %W PgUp"
  545.         bind Listbox <Next>  "LBscroll_kb %W PgDn"
  546.         bind Listbox <End>  "LBscroll_kb %W End"
  547. }
  548.  
  549.  
  550. proc ShowKey {} {
  551.         toplevel .showKey 
  552.         wm title    .showKey "Show Keypresses"
  553.         wm geometry .showKey 500x200
  554.  
  555.         label .showKey.l -relief flat
  556.         button .showKey.b -text OK -command { destroy .showKey }
  557.         pack .showKey.l -in .showKey -fill both -expand 1 -side top
  558.         pack .showKey.b -in .showKey -fill x    -expand 0 -side top -padx 5 -pady 5
  559.  
  560.         .showKey.l configure -text "KeyCode: %k; KeySym: %K;"
  561.         focus .showKey.l
  562.  
  563.         bind .showKey.l <Any-KeyPress> { 
  564.                 .showKey.l configure -text "KeyCode: %k; KeySym: %K;"
  565.         }
  566. }
  567.  
  568.  
  569.  
  570.  
  571. ################################################################
  572. # This runs ps with the (optional) user command line args.
  573. # It fills the listbox with a list of all the processes running,
  574. # using the ps output. 
  575. #
  576. # How do we locate the PID of a process?
  577. #
  578. # We then look through the keyword (header) list to see if we find the PID
  579. # column, and remember which column that is, so we can operate on selected
  580. # processes. Yeesh. After we do 'split' on each line of output, we need
  581. # to eliminate the multiple blanks, and we still are hoping that ps
  582. # doesn't insert a blank between two words in a column. There is no
  583. # direct portable system call which gives basic process information about
  584. # all processes on a machine. There is just 'ps', and we are parsing the
  585. # random text output of a stupid utility program. 
  586. #
  587. # Argh. unix sucks. 
  588.         
  589. label .header -relief groove -anchor w -font $tfont
  590. pack .header -side top -anchor w -fill x
  591.  
  592.  
  593. scrollbar .scroll -command ".list yview"
  594. pack .scroll -side right -fill y
  595.  
  596. wm minsize . 1 1
  597.  
  598. listbox .list   -relief groove  -geometry 100x25 \
  599.          -yscroll ".scroll set" \
  600.         -setgrid yes -font $tfont \
  601.         -yscrollcommand "LBscroll_sb .list .scroll y" \
  602.  
  603.  
  604. pack .list -side top -expand yes -fill both -anchor w
  605.  
  606. # bind the keyboard command to work (pageup pagedown, uparrow, home, etc)
  607. LBbindScroll
  608.  
  609. ################################################################
  610. # Set up args to 'ps'.
  611. # We either got args from the command line, or we default
  612. # to -auxww
  613. if $argc>0 {set ps_args [lindex $argv 0]} \
  614.          else {set ps_args $DEFAULT_PS_ARGS}
  615.  
  616.  
  617. # This runs ps and gets the results into a list of entries.
  618. # FILTER is a variable used to filter the results, a la grep.  
  619.  
  620. proc get_unix_procs {filter} {
  621.   global ps_args
  622.   # The PID column is the column which has the pid numbers in it. 
  623.   # This can change depending on the options passed to 'ps'.
  624.   global pid_column argc argv
  625.   
  626.   # save the old list scroll value 
  627.   set oldyview [.list nearest 0]
  628.   set oldsize [.list size]
  629.  
  630.   # Open a pipe to the "ps" program, with some args.
  631.   set unix_procs_fd  [open "|ps $ps_args"] 
  632.  
  633.   # Get the column headers, from the first line of output from ps.
  634.   set header [gets $unix_procs_fd]
  635.   .header config -text $header
  636.  
  637.   set ps_columns [strip_blanks $header]
  638.   set pid_column [lsearch $ps_columns "PID"]
  639.   if { $pid_column < 0 } {
  640.     puts "Couldn't locate the PID column in the output from 'ps' \
  641. so I can't send a signal to a process:"
  642.     puts $header
  643.     exit 1
  644.   }
  645.  
  646.   # Clear the list items.
  647.   .list delete 0 [.list size ]
  648.   # Fill in listbox with process entries from 'ps' command output.
  649.   while { [set i [gets $unix_procs_fd]] != {}  }  {
  650.       if [regexp $filter $i] {
  651.       .list insert end $i
  652.       }
  653.  }
  654.  
  655.  close $unix_procs_fd
  656.  
  657.  # if the list has not changed size much, try to preserve viewpoint
  658.  if {abs([.list size] - $oldsize) < 2} {
  659.  .list yview $oldyview
  660.  }
  661. }
  662.  
  663. proc update_unix_procs {} {
  664.   global greppat
  665.   get_unix_procs $greppat
  666. }
  667.  
  668. ################################################################
  669. # Finds first entry matching $findpat 
  670. #
  671. # Also scrolls the display to make the item visible if it is not already.
  672.  
  673. proc find_unix_proc {} {
  674.   global findpat
  675.   set entries [.list size]
  676.   for { set i 0} { $i < $entries } { incr i }  {
  677.    if [regexp $findpat [.list get $i]] {
  678.       .list yview $i
  679.       .list select adjust $i
  680.       break
  681.       }
  682.   }
  683. }
  684.  
  685. # Set up bindings for the browser.
  686.  
  687. bind .list <Control-q> {destroy .}
  688. bind .list <Control-c> {destroy .}
  689. focus .list
  690. bind .list <Double-Button-1> \
  691.         { set oldconfirm $confirm_signals
  692.           set confirm_signals 1
  693.           foreach i [.list curselection] {show_pinfo}
  694.           set confirm_signals $oldconfirm
  695.         }
  696.  
  697. # Try to make the listbox toggle selections when you click again
  698. #bind .list <Button-1> {
  699. #       set csel  [%W nearest %y] 
  700. #       # Is the selected object already selected?? 
  701. #       if {[lsearch [.list curselection] $csel] != -1} {
  702. #               #If so, clear the selection 
  703. #               .list select clear } else {
  704. #               %W select from $csel
  705. #       }
  706. #}
  707.  
  708.  
  709.  
  710.  
  711.  
  712.  
  713. proc signals_menu {ps_string} {
  714.    global fields
  715.    set fields [strip_blanks [split $ps_string " "]];
  716.    puts $fields         
  717. }
  718.  
  719.  
  720. # Send signal looks at the currently selected entries in the listbox
  721. # and sends the signal to all of them.
  722. proc send_signal {signal} {
  723.  global confirm_signals 
  724.  set pids [selected_processes]
  725.  set proceed 1
  726.  if {$pids != {}} {
  727.   if {$confirm_signals} {set proceed [confirm_dialog $signal $pids]}
  728.   if {$proceed} {
  729.     eval exec [format "kill -%s" $signal] $pids 
  730.   }
  731.   update_unix_procs
  732.  }
  733. }
  734.  
  735. # get the selected entries from the listbox and extract
  736. # the pid fields from each selection
  737. proc selected_processes {} {
  738.   global pid_column     
  739.   set z {}
  740.   foreach i [.list curselection] {
  741.      set fields [strip_blanks [split [.list get $i] " "]];
  742.      lappend z [lindex $fields $pid_column]
  743.   }
  744.   return $z
  745. }
  746.  
  747.  
  748. # The loop running in the background. 
  749. # We want to make sure that we don't update if there is 
  750. # a current selection in the window.
  751. proc update_loop {} {
  752.    global UPDATE_PERIOD
  753.    if {[.list curselection] == {}} {
  754.     update_unix_procs
  755.    }
  756.     after $UPDATE_PERIOD update_loop
  757. }
  758.  
  759. ################
  760. # The main loop !
  761. update_loop
  762.  
  763.  
  764. ################################################################
  765. #
  766. # Dialog box for confirmation of kill command 
  767. #
  768. # Returns 1 if proceed, 0 if cancel
  769. #
  770.  
  771. proc confirm_dialog {signame pids} {
  772.  
  773.   global val
  774.   set val 1
  775.   # create top level window
  776.   toplevel .confirm -class Dialog
  777.   wm title .confirm "Confirm Kill Command"
  778.   wm iconname .confirm Dialog
  779.   frame .confirm.top -relief raised -bd 1
  780.   pack .confirm.top -side top -fill both
  781.   frame .confirm.bot -relief raised -bd 1
  782.   pack .confirm.bot -side bottom -fill both
  783.  
  784.  message .confirm.top.msg -width 3i \
  785.    -text "Send $signame to processes $pids ?" \
  786.    -font -Adobe-helvetica-medium-r-normal--*-120-* -aspect 200 
  787.  pack .confirm.top.msg -side right -expand yes -fill both -padx 3m -pady 3m
  788.  
  789.  label .confirm.top.bitmap  -bitmap warning 
  790.  pack  .confirm.top.bitmap  -side left -padx 3m -pady 3m
  791.  
  792.  frame .confirm.bot.default -relief sunken -bd 1
  793.  raise .confirm.bot.default
  794.  pack .confirm.bot.default -side left -expand yes -padx 3m -pady 2m
  795.  
  796.  button .confirm.bot.ok  -text "OK"  -bd 1 \
  797.         -command {set val 1}
  798.  pack  .confirm.bot.ok -in .confirm.bot.default \
  799.        -side left -padx 2m -pady 2m \
  800.        -ipadx 2m -ipady 1m
  801.  
  802.  button .confirm.bot.cancel -text "Cancel"  -bd 1 \
  803.         -command {set val 0}
  804.  pack .confirm.bot.cancel -side left -expand yes \
  805.       -padx 3m -pady 2m -ipadx 2m -ipady 1m
  806.  
  807.  bind .confirm <Return> ".confirm.bot.ok flash; set val 1"
  808.  
  809.  set oldFocus [focus]
  810.  
  811.  grab set .confirm
  812.  focus .confirm
  813.  
  814.  tkwait variable val
  815.  destroy .confirm
  816.  focus $oldFocus
  817.  return $val
  818. }
  819.  
  820.   
  821.    
  822. ################################################################
  823. proc msg_dialog {msg} {
  824.  toplevel .helpwin
  825.  
  826.  message .helpwin.msg -text $msg \
  827.      -font -Adobe-helvetica-medium-r-normal--*-120-* -aspect 200
  828.  
  829.   button .helpwin.ok -text OK -command { destroy .helpwin }
  830.   pack .helpwin.msg .helpwin.ok -side top 
  831. }
  832.  
  833.  
  834.  
  835. proc help_dialog {} {
  836.   msg_dialog {This program will send a signal to the selected process. There \
  837. are several equivalent ways to choose a signal to send. \
  838.  
  839. First, select a process from the list below, then select a signal \
  840. to send to it, either using a button on the bottom of the window, \
  841. or from one of the signal menus. The commonly used signals have their own buttons along the bottom of the window. 
  842.  
  843. The signal menus contain the following (redundant) sets of signals:
  844.  Common_Signals contains commonly used signals. 
  845. POSIX_Signals contains POSIX standard signals.
  846. All_signals contains all signals available. 
  847.  
  848. The "Filter" text entry field is essentially equivalent to "ps auxww | grep foo" for some value of foo. 
  849.  
  850. The "Find" entry box lets you select the first process matching the entry foo. 
  851.  
  852. The Options menu contains some configuration settings.
  853.  "Confirm"  will pop up a dialog before executing a kill command.
  854.  "List Common Process Info": double click on process pops up dialog of common useful process info.  
  855.  "List ALL Process Info": double click on process pops up dialog of ALL process info available through ps.  
  856.  "Set Update Period" adjusts the time between updating the display (and running "ps" again, which is expensive for some reason. 
  857.  "Set Command Line Args" sets the option string which is sent to ps. It defaults to "-auxww" }
  858.  
  859. }
  860.  
  861. proc about_box {} {
  862.   msg_dialog {The tkps browser was written by Henry Minsky (hqm@ai.mit.edu)
  863.  
  864. This is Version 1.1, May 1994
  865.  
  866. Terms of the GNU public license apply.
  867. }
  868. }
  869.  
  870. ################################################################
  871. # This ought to be a generic program to change a variable's value
  872. proc change_update_period {} {
  873.   global UPDATE_PERIOD MIN_UPDATE_PERIOD menufont update_time
  874.   set update_time $UPDATE_PERIOD
  875.   catch {destroy .update}
  876.   # create top level window
  877.   toplevel .update -class Dialog
  878.   wm title .update "Set Update Period"
  879.   wm iconname .update Dialog
  880.   frame .update.bot -relief raised -bd 1
  881.   frame .update.top -relief raised -bd 1
  882.   pack .update.top -side top -fill both
  883.   pack .update.bot -side bottom -fill both
  884.  
  885.   button .update.bot.ok -relief raised \
  886.     -text "OK" -command {destroy .update} -font $menufont
  887.  
  888.   pack .update.bot.ok -side bottom -ipadx 6m -ipady 2m -expand yes
  889.  
  890.  label .update.top.label -text "Update period (ms):"
  891.  entry .update.top.val  -width 20 -relief sunken \
  892.                          -bd 2 -textvariable update_time
  893.  
  894.  pack .update.top.label .update.top.val \
  895.       -side left -padx 6m -ipadx 3m
  896.  
  897.  bind .update.top.val <Return> "destroy .update"
  898.  
  899.  set oldFocus [focus]
  900.  
  901.  grab set .update
  902.  focus .update.top
  903.  
  904.  tkwait window .update
  905.  
  906.  focus $oldFocus
  907.  
  908.  # Don't let the updates go too fast.
  909.  if {$update_time < $MIN_UPDATE_PERIOD} {
  910.      set UPDATE_PERIOD $MIN_UPDATE_PERIOD} else {
  911.      set UPDATE_PERIOD $update_time }
  912.  
  913.  
  914. }
  915.  
  916. ################################################################
  917. # Dialog to change args to ps. This should call a dialog subroutine.
  918. #
  919. proc change_ps_args {} {
  920.   global ps_args newargs menufont DEFAULT_PS_ARGS
  921.   catch {destroy .newargs}
  922.   set args $ps_args
  923.   # create top level window
  924.   toplevel .newargs -class Dialog
  925.   wm title .newargs "Set Command Line Args"
  926.   wm iconname .newargs Dialog
  927.   frame .newargs.bot -relief raised -bd 1
  928.   frame .newargs.top -relief raised -bd 1
  929.   pack .newargs.top -side top -fill both
  930.   pack .newargs.bot -side bottom -fill both
  931.  
  932.   button .newargs.bot.ok -relief raised \
  933.     -text "OK" -command {destroy .newargs} -font $menufont
  934.  
  935.   pack .newargs.bot.ok -side bottom -ipadx 6m -ipady 2m -expand yes
  936.  
  937.  label .newargs.top.label -text "Command Line Args To \"ps\":"
  938.  entry .newargs.top.val  -width 30 -relief sunken \
  939.                          -bd 2 -textvariable newargs
  940.  
  941.  pack .newargs.top.label .newargs.top.val \
  942.       -side left -padx 6m -ipadx 3m
  943.  
  944.  bind .newargs.top.val <Return> "destroy .newargs"
  945.  
  946.  set oldFocus [focus]
  947.  
  948.  grab set .newargs
  949.  focus .newargs.top
  950.  
  951.  tkwait window .newargs
  952.  
  953.  focus $oldFocus
  954.  
  955.  # Don't let the updates go too fast.
  956.  if {$newargs != ""} {
  957.         set ps_args $newargs} else {
  958.         set ps_args $DEFAULT_PS_ARGS }
  959.  
  960.  update_unix_procs
  961. }
  962.  
  963. # runs 'man' on the NAME given, and puts the output
  964. # in a text widget 
  965. proc manpage {name} {
  966.  
  967.  text .text -releif raised -bd 2 \
  968.         -yscrollcommand ".scrolltext set"
  969.  scrollbar .scrolltext -command ".text yview"
  970.  
  971.  
  972.  
  973. }
  974.  
  975. ################################################################
  976. # Routines to display a popup text widget with detailed info on a process
  977.  
  978.  
  979. # Makes a comma separated list of the first item in each list
  980. # in a list of lists.
  981. proc first_items {l} {
  982.  set z {}
  983.  foreach i $l {
  984.    set keyword [lindex $i 0];
  985.    set z [lappend z $keyword];
  986.  }
  987.  return [join $z ","];
  988. }
  989.  
  990.  
  991.  
  992. # call ps on a specific pid, and put text into text widget 
  993. proc fill_info_window {pid widget} {
  994.   global list_which_signals PROCESS_FLAGS
  995.  
  996.   # We need to run ps twice, once to get the command name, which has spaces
  997.   # in it, and once more for all the other keywords that hopefully
  998.   # have no spaces inside individual items. That's ps. One tool which does
  999.   # its job badly. 
  1000.  
  1001.   # Oh, I hear you say. Unix processes are inexpensive. Run ps once
  1002.   # for each keyword arg. Then you won't have to worry about ambiguous separators
  1003.   # in the output. Yeah, ok, sure. whatever. Why fight it. I don't care anymore. 
  1004.  
  1005.   set unix_procs_fd  [open "|ps -p $pid -o command"] 
  1006.   gets $unix_procs_fd; # strip header
  1007.   set command   [gets $unix_procs_fd]
  1008.   close $unix_procs_fd
  1009.  
  1010.   $widget insert end [format "COMMAND: %s\n_______________________________\n" $command];
  1011.  
  1012.   # Open a pipe to the "ps" program, with some args.
  1013.   set args [format "state,flags,%s" [first_items $list_which_signals] ]
  1014.  
  1015.   set unix_procs_fd  [open "|ps -p $pid -o $args"] 
  1016.  
  1017.   # Get the column headers, from the first line of output from ps.
  1018.   gets $unix_procs_fd   
  1019.   # actually just discard it
  1020.  
  1021.   set pstats [strip_blanks [gets $unix_procs_fd]]
  1022.  
  1023.   close $unix_procs_fd
  1024.  
  1025.   # Look at the process run state, and get the doc strings for each flag
  1026.   set pstate [lindex $pstats 0]
  1027.   set len [string length $pstate]
  1028.   for {set i 0} { $i < $len } { incr i }  {
  1029.      set state_entries [lookup_proc_state [string index $pstate $i]]
  1030.      $widget insert end $state_entries 
  1031.      $widget insert end "\n"
  1032.  }
  1033.  
  1034.  scan [lindex $pstats 1] "%x" flags
  1035.  # try to decode the process flags
  1036.  $widget insert end "\nPROCESS FLAGS:\n"
  1037.  # {SLOAD         0x0000001     in core}
  1038.  # {SPTECHG       0x4000000     pte's for process have changed}
  1039.  
  1040.  # step through the bits of the flag, see which are set
  1041.  for { set i 0} { $i < 20} {incr i} {
  1042.    if { ($flags & (1 << $i )) != 0} {
  1043.       set docstring [lindex $PROCESS_FLAGS $i];
  1044.       $widget insert end [format "%s\n" $docstring];
  1045.    }
  1046.  }
  1047.  
  1048.  $widget insert end "\n_______________________________\n"
  1049.  # Print rest of keyword fields and doc strings.
  1050.  
  1051.  set lim [llength $list_which_signals];
  1052.  
  1053.  for {set k 2} {$k < $lim } {incr k} {
  1054.   set entry  [lindex $list_which_signals [expr $k - 2]]
  1055.   $widget insert end [format "%s:\t%s\t%s\n" [lindex $entry 0] \
  1056.          [lindex $pstats $k] \
  1057.          [lrange $entry 1 end]]
  1058.  }
  1059. }
  1060.  
  1061.  
  1062. proc show_pinfo {} {
  1063.   set sp [selected_processes]
  1064.   foreach p $sp { 
  1065.     show_detailed_proc $p
  1066.   }
  1067. }
  1068.  
  1069. proc show_detailed_proc {pid} {
  1070.  
  1071.   global menufont 
  1072.   set P .pinfo$pid
  1073.   set TOP $P.top
  1074.  
  1075.   # create top level window
  1076.   toplevel $P -class Dialog
  1077.  
  1078.   frame $TOP -relief raised -bd 1
  1079.   pack $TOP -side top -fill both
  1080.   frame $P.bot -relief raised -bd 1
  1081.   pack $P.bot -side bottom -fill both
  1082.  
  1083.   # text widget for process info strings
  1084.   text $TOP.text -relief raised -bd 2 \
  1085.          -yscrollcommand "$TOP.scroll set"
  1086.   scrollbar $TOP.scroll -command "$TOP.text yview"
  1087.  
  1088.  
  1089.   fill_info_window $pid $TOP.text
  1090.  
  1091.   pack $TOP.scroll -side right -fill y
  1092.   pack $TOP.text -side left
  1093.  
  1094.   wm title $P "Process $pid Info"
  1095.   wm iconname $P "PID $pid"
  1096.  
  1097.   frame $P.bot.default -relief sunken -bd 1
  1098.   raise $P.bot.default
  1099.  
  1100.   button $P.bot.ok  -text "DISMISS"  -bd 1 -relief raised\
  1101.           -command  [list "destroy" $P] -font $menufont 
  1102.   button $P.bot.kill  -text "KILL PROCESS"  -bd 1 -relief raised\
  1103.           -command  [list "exec" "kill" "-KILL" $pid] -font $menufont
  1104.  
  1105.   pack  $P.bot.ok -in $P.bot.default \
  1106.        -side left -padx 2m -pady 2m \
  1107.        -ipadx 2m -ipady 1m
  1108.  
  1109.   pack $P.bot.default $P.bot.kill -side left -expand yes \
  1110.         -padx 3m -pady 2m  -ipadx 2m -ipady 1m
  1111.  
  1112.  bind $P <Return> "$P.bot.ok flash; set val 1"
  1113.  
  1114. }
  1115.