1 ;;; view-process-mode.el --- Display current running processes
3 ;; Copyright (C) 1994, 1995, 1996 Heiko Muenkel
5 ;; Author: Heiko Muenkel <muenkel@tnt.uni-hannover.de>
8 ;; This file is part of XEmacs.
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your
13 ;; option) any later version.
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; See the file COPYING. if not, write to the Free
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 ;;; Synched up with: Emacs 20.1
29 ;; $Id: view-process-mode.el,v 1.4 2002-08-17 11:25:37 scop Exp $
30 ;; This file defines the the view-process-mode, a mode for displaying
31 ;; the current processes with ps on UNIX systems. There are also
32 ;; commands to sort and filter the output and to send signals to the
35 ;; You can display the processes with the command `view-processes'.
36 ;; If you are familiar with the UNIX ps command and its switches,
37 ;; then you can also use the command `View-process-status' or
38 ;; its short cut `ps', which are asking for the command
39 ;; switches. You can also run the commands on a remote system
40 ;; via rsh. For that you must give a prefix arg to the
41 ;; commands. This leads to a question for the remote host name.
43 ;; You need also the files: adapt.el
44 ;; view-process-system-specific.el
45 ;; view-process-xemacs.el
46 ;; view-process-emacs-19.el
50 ;; Put this file and the file adapt.el
51 ;; in one of your your load-path directories and
52 ;; the following line in your ~/.emacs (without leading ;;;):
53 ;; (autoload 'ps "view-process-mode"
54 ;; "Prints a list with processes in the buffer `View-process-buffer-name'.
55 ;; COMMAND-SWITCHES is a string with the command switches (ie: -aux).
56 ;; IF the optional argument REMOTE-HOST is given, then the command will
57 ;; be executed on the REMOTE-HOST. If an prefix arg is given, then the
58 ;; function asks for the name of the remote host."
61 ;; In the FSF Emacs 19 you should (but must not) put the following
62 ;; line in your ~/.emacs:
63 ;;; (transient-mark-mode nil)
67 (provide 'view-process-mode)
68 (require 'view-process-system-specific)
70 (defconst View-process-package-version "2.4")
72 (defconst View-process-package-name "hm--view-process")
74 (defconst View-process-package-maintainer "muenkel@tnt.uni-hannover.de")
76 (defun View-process-xemacs-p ()
77 "Return non-nil if the editor is XEmacs or lemacs."
78 (or (string-match "Lucid" emacs-version)
79 (string-match "XEmacs" emacs-version)))
81 (defun View-process-lemacs-p ()
82 "Return non-nil if the editor is lemacs."
83 (string-match "Lucid" emacs-version))
85 (if (not (View-process-xemacs-p))
86 (require 'view-process-adapt)
89 (defvar View-process-status-command "ps"
90 "*Command which reports process status (ps).
91 The variable is buffer local.")
93 (make-variable-buffer-local 'View-process-status-command)
95 (defvar View-process-status-command-switches-bsd "-auxw"
96 "*Switches for the command `view-processes' on BSD systems.
97 Switches which suppresses the header line are not allowed here.")
99 (defvar View-process-status-command-switches-system-v "-edaf"
100 "*Switches for the command `view-processes' on System V systems.
101 Switches which suppresses the header line are not allowed here.")
103 (defvar View-process-status-last-command-switches nil
104 "Switches of the last `View-process-status-command'.
105 The variable is buffer local.")
107 (make-variable-buffer-local 'View-process-status-last-command-switches)
109 (defvar View-process-signal-command "kill"
110 "*Command which sends a signal to a process (kill).
111 The variable is buffer local.")
113 (make-variable-buffer-local 'View-process-signal-command)
115 (defvar View-process-renice-command "renice"
116 "*Command which alter priority of running processes.")
118 (make-variable-buffer-local 'View-process-renice-command)
120 (defvar View-process-default-nice-value "4"
121 "*Default nice value for altering the priority of running processes.")
123 (defvar View-process-rsh-command "rsh"
124 "*Remote shell command (rsh).
125 The variable is buffer local.")
127 (make-variable-buffer-local 'View-process-rsh-command)
129 (defvar View-process-uname-command "uname"
130 "*The uname command (It returns the system name).
131 The variable is buffer local.")
133 (make-variable-buffer-local 'View-process-uname-command)
135 (defvar View-process-uname-switches "-sr"
136 "*Switches for uname, so that it returns the sysname and the release.")
138 (defvar View-process-test-command "test"
139 "*The test command.")
141 (make-variable-buffer-local 'View-process-test-command)
143 (defvar View-process-test-switches "-x"
144 "*Switches for test, to test if an executable exists.")
146 (defvar View-process-uptime-command "uptime"
147 "*The uptime command.
148 No idea at the moment, if this exists on all systems.
149 It should return some informations over the system.")
151 (make-variable-buffer-local 'View-process-uptime-command)
153 (defvar View-process-buffer-name "*ps*"
154 "Name of the output buffer for the 'View-process-mode'.
155 The variable is buffer local.")
157 (make-variable-buffer-local 'View-process-buffer-name)
159 (defvar View-process-mode-hook nil
160 "*This hook is run after reading in the processes.")
162 (defvar View-process-motion-help t
163 "*If non-nil, then help messages are displayed during mouse motion.
164 The variable is buffer local.")
166 (make-variable-buffer-local 'View-process-motion-help)
168 (defvar View-process-display-with-2-windows t
169 "*Determines the display type of the `View-process-mode'.
170 If it is non-nil, then 2 windows are used instead of one window.
171 In the second window are the header lines displayed.")
173 (defvar View-process-hide-header t
174 "*If t, the header lines in the view processes buffer are hidden.")
176 (make-variable-buffer-local 'View-process-hide-header)
178 (defvar View-process-truncate-lines t
179 "*Truncates the lines in the view process buffer if t.")
181 (make-variable-buffer-local 'View-process-truncate-lines)
183 (defvar View-process-display-short-key-descriptions t
184 "*Controls whether short key descriptions are displayed or not.")
186 (defvar View-process-display-uptime t
187 "*Controls whether uptime is displayed or not.")
189 (defvar View-process-use-font-lock t
190 "*Controls whether `font-lock-mode' is used or not.")
192 (defvar View-process-ps-header-window-offset 2
193 "Offset for the size of the ps header window.")
195 (defvar View-process-ps-header-window-size 0
196 "Internal variable. The size of the window with the *ps header* buffer.")
198 (make-variable-buffer-local 'View-process-ps-header-window-size)
200 (defvar View-process-stop-motion-help nil
201 "Internal variable. Stops motion help temporarily.")
203 (defvar View-process-deleted-lines nil
204 "Internal variable. A list with lines, which are deleted by a filter.")
206 (make-variable-buffer-local 'View-process-deleted-lines)
208 (defvar View-process-header-buffer-name "*ps header*"
209 "Name of the view process header buffer.")
211 (make-variable-buffer-local 'View-process-header-buffer-name)
213 (defvar View-process-header-mode-name "psheader"
214 "Name of the `view process header mode'.")
216 (defvar View-process-header-mode-hook nil
217 "*This hook is run after building the header buffer.")
219 (defvar View-process-header-mode-line-off t
220 "*t means do not display modeline in `View-process-header-mode'.
221 This works only in XEmacs 19.12 and higher.")
223 (defvar View-process-header-line-detection-list '("PID" "COMMAND" "COMD" "CMD")
224 "*The header line is detected with the help of this list.
225 At least one of these words must be in a header line. Otherwise
226 an error is signaled. You must only change this list if your ps
227 produces header lines with strings that are not in this list.")
229 (defvar View-process-header-line-background "yellow"
230 "*Background color of the header line.")
232 (defvar View-process-header-line-foreground "blue"
233 "*Foreground color of the header line.")
235 (defvar View-process-header-line-font (face-font 'bold)
236 "*Font of the header line.")
238 (defvar View-process-header-line-underline-p t
239 "*t if the header line should be underlined.")
241 (defvar View-process-no-mark ?_
242 "*A character which specifies that a line isn't marked.")
244 (defvar View-process-signaled-line-background nil
245 "*Background color of the line with a signaled or reniced process.")
247 (defvar View-process-signaled-line-foreground "grey80"
248 "*Foreground color of the line with a signaled or reniced process.")
250 (defvar View-process-signaled-line-font (face-font 'italic)
251 "*Font of the line with a signaled or reniced process.")
253 (defvar View-process-signaled-line-underline-p nil
254 "*t if the \"signaled line\" should be underlined.")
256 (defvar View-process-signaled-line-mark ?s
257 "*A character, which is used as a mark for \"signaled lines\".")
259 (defvar View-process-signal-line-background nil
260 "*Background color of the line with the process which should be signaled.")
262 (defvar View-process-signal-line-foreground "red"
263 "*Foreground color of the line with the process which should be signaled.")
265 (defvar View-process-signal-line-font (face-font 'bold)
266 "*Font of the line with the process which should be signaled.")
268 (defvar View-process-signal-line-underline-p nil
269 "*t if the \"signal line\" should be underlined.")
271 (defvar View-process-signal-line-mark ?K
272 "*A character which is used as a mark for \"signal lines\".")
274 (defvar View-process-renice-line-background nil
275 "*Background color of the line with the process which should be reniced.")
277 (defvar View-process-renice-line-foreground "red"
278 "*Foreground color of the line with the process which should be reniced.")
280 (defvar View-process-renice-line-font (face-font 'bold)
281 "*Font of the line with the process which should be reniced.")
283 (defvar View-process-renice-line-underline-p nil
284 "*t if the \"renice line\" should be underlined.")
286 (defvar View-process-renice-line-mark ?N
287 "*A character which is used as a mark for \"renice lines\".")
289 (defvar View-process-child-line-background nil
290 "*Background color of a line with a child process.")
292 (defvar View-process-child-line-foreground "darkviolet"
293 "*Foreground color of a line with a child process.")
295 (defvar View-process-child-line-font (face-font 'italic)
296 "*Font color of a line with a child process.")
298 (defvar View-process-child-line-underline-p nil
299 "*t if the \"line with a child process\" should be underlined.")
301 (defvar View-process-child-line-mark ?C
302 "*A character, which is used as a mark for child processes.")
304 (defvar View-process-parent-line-background "LightBlue"
305 "*Background color of a line with a parent process.")
307 (defvar View-process-parent-line-foreground "darkviolet"
308 "*Foreground color of a line with a parent process.")
310 (defvar View-process-parent-line-font (face-font 'bold)
311 "*Font color of a line with a parent process.")
313 (defvar View-process-parent-line-underline-p t
314 "*t if the \"line with a parent\" should be underlined.")
316 (defvar View-process-parent-line-mark ?P
317 "*A character which is used as a mark for parent processes.")
319 (defvar View-process-single-line-background nil
320 "*Background color of a line with a single line mark.")
322 (defvar View-process-single-line-foreground "darkblue"
323 "*Foreground color of a line with a single line mark.")
325 (defvar View-process-single-line-font (face-font 'bold)
326 "*Font color of a line with a single line mark.")
328 (defvar View-process-single-line-underline-p t
329 "*t if the \"line with a single line mark\" should be underlined.")
331 (defvar View-process-single-line-mark ?*
332 "*A character which is used as a single line mark.")
334 (defvar View-process-font-lock-keywords
337 (char-to-string View-process-child-line-mark)
339 'View-process-child-line-face)
341 (char-to-string View-process-parent-line-mark)
343 'View-process-parent-line-face)
345 (char-to-string View-process-single-line-mark)
347 'View-process-single-line-face)
349 (char-to-string View-process-signaled-line-mark)
351 'View-process-signaled-line-face)
353 (char-to-string View-process-signal-line-mark)
355 'View-process-signal-line-face)
357 (char-to-string View-process-renice-line-mark)
359 'View-process-renice-line-face)
361 "The font lock keywords for the `View-process-mode'."
364 (defvar View-process-pid-mark-alist nil
365 "Internal variable. An alist with marks and pids.")
367 (make-variable-buffer-local 'View-process-pid-mark-alist)
369 (defvar View-process-last-pid-mark-alist nil
370 "Internal variable. An alist with the last marks and pids.")
372 (make-variable-buffer-local 'View-process-last-pid-mark-alist)
374 (defvar View-process-sorter-and-filter nil
375 "*A list which specifies sorter and filter commands.
376 These commands will be run over the ps output every time after
377 ps has created a new output.
378 The list consists of sublists, whereby every sublist specifies a
379 command. The first element of each list is a keyword which
380 determines a command.
381 The following keywords are allowed:
382 sort - Sort the output by an output field
383 filter - Filter the output by an output field, delete non matching l.
384 exclude-filter - Filter the output by an output field, delete matching lines
385 grep - Filter the output by the whole line, delete non matching l.
386 exclude-grep - Filter the output by the whole line, delete matching lines
387 reverse - Reverse the order of the output lines.
389 The cdr of each sublist depends on the keyword. The following shows
390 the syntax of the different sublist types:
392 (filter <fieldname> <regexp>)
393 (exclude-filter <fieldname> <regexp>)
395 (exclude-grep <regexp>)
398 Where <fieldname> is a string with determines the name of an output field
399 and <regexp> is a string with an regular expression. The output field names
400 are derived from the header line of the ps output.")
402 (defvar View-process-actual-sorter-and-filter nil
403 "Internal variable. It holds the actual sorter and filter commands.
406 (make-variable-buffer-local 'View-process-actual-sorter-and-filter)
408 (defvar View-process-itimer-value 5
409 "*Value of the view process itimer.")
411 (defvar View-process-system-type nil
412 "Internal variable. Type of the system, on which the ps command is called.
413 The variable is buffer local.")
415 (make-variable-buffer-local 'View-process-system-type)
417 (defvar View-process-remote-host nil
418 "Internal variable. Name of the remote host or nil.
419 The variable is buffer local.")
421 (make-variable-buffer-local 'View-process-remote-host)
423 (defvar View-process-header-start nil
424 "Internal variable. Start of the ps output header line.
425 The variable is buffer local.")
427 (make-variable-buffer-local 'View-process-header-start)
429 (defvar View-process-header-end nil
430 "Internal variable. End of the ps output header line.
431 The variable is buffer local.")
433 (make-variable-buffer-local 'View-process-header-end)
435 (defvar View-process-output-start nil
436 "Internal variable. Start of the ps output (after the header).
437 The variable is buffer local.")
439 (make-variable-buffer-local 'View-process-output-start)
441 (defvar View-process-output-end nil
442 "Internal variable. End of the ps output (after the header).
443 The variable is buffer local.")
445 (make-variable-buffer-local 'View-process-output-end)
447 (defvar View-process-old-window-configuration nil
448 "Internal variable. Window configuration before the first ps command.")
450 (make-variable-buffer-local 'View-process-old-window-configuration)
452 (defvar View-process-max-fields nil
453 "Internal variable. Number of output fields.
454 The variable is buffer local.")
456 (make-variable-buffer-local 'View-process-max-fields)
458 (defvar View-process-field-names nil
459 "Internal variable. An alist with the fieldnames and fieldnumbers.
460 The variable is buffer local.")
462 (make-variable-buffer-local 'View-process-max-fields)
464 (defvar View-process-field-blanks-already-replaced nil
465 "Internal variable. It is t if blanks in fields are already replaced.")
467 (make-variable-buffer-local 'View-process-field-blanks-already-replaced)
469 (defvar View-process-kill-signals nil
470 "An alist with the possible signals for the kill command.
471 Don't change it by hand!
472 The variable is initialized each time after running ps.
473 The variable is buffer local.")
475 (make-variable-buffer-local 'View-process-kill-signals)
477 (defvar View-process-kill-signals-general
478 '(("SIGHUP" "1") ("SIGKILL" "9") ("SIGTERM" "15")
479 ("1" "1") ("2" "2") ("3" "3") ("4" "4") ("5" "5") ("6" "6") ("7" "7")
480 ("8" "8") ("9" "9") ("10" "10") ("11" "11") ("12" "12") ("13" "13")
481 ("14" "14") ("15" "15") ("16" "16") ("17" "17") ("18" "18")
482 ("19" "19") ("20" "20") ("21" "21") ("22" "22") ("23" "23")
483 ("24" "24") ("25" "25") ("26" "26") ("27" "27") ("28" "28")
484 ("29" "29") ("30" "30") ("31" "31"))
485 "An alist with the possible signals for the kill command.
486 This list is used, if no system specific list is defined.
487 It may be that you've other signals on your system. Try to test
488 it with \"kill -l\" in a shell.")
490 (defvar View-process-default-kill-signal "SIGTERM"
491 "*Default signal for the function `View-process-send-signal-to-process'.
492 The string must be also in the alist `View-process-kill-signals'!")
494 (defvar View-process-pid-field-name "PID"
495 "*The name of the field with the PIDs.
496 The name must be the same as in the first output line of the
497 command `View-process-status-command' (ps).
498 The variable is buffer local.")
500 (make-variable-buffer-local 'View-process-pid-field-name)
502 (defvar View-process-ppid-field-name "PPID"
503 "*The name of the field with the PPIDs.
504 The name must be the same as in the first output line of the
505 command `View-process-status-command' (ps).
506 The variable is buffer local.")
508 (make-variable-buffer-local 'View-process-ppid-field-name)
510 (defvar View-process-host-names-and-system-types nil
511 "A list with the names and the system types of hosts.
512 Each entry of the list looks like the following:
513 (<hostname> (<system-type> <version-number> <bsd-or-system-v>
514 <field-name-descriptions>
516 Here are some examples:
517 (\"daedalus\" (\"sunos\" \"4\" \"bsd\"
518 View-process-field-name-descriptions-sunos4
519 View-process-kill-signals-sunos4))
520 (\"bach\" (\"linux\" nil \"bsd\"
522 View-process-kill-signals-linux
524 (\"cesar\" (nil nil \"bsd\"))
525 The list will be enhanced by the program, each time you run ps on
526 a new system. But you can also set this variable by hand in your
527 .emacs. If the host name is found in this list, then the system
528 type will not be checked again."
531 (defvar View-process-status-history nil
532 "A list with the command switch history of the status command (ps).")
534 (defvar View-process-remote-host-history nil
535 "A list with the remote host history.")
537 (defvar View-process-field-name-history nil
538 "A list with the field name history.")
540 (defvar View-process-filter-history nil
541 "A list with the filter history.")
543 (defvar View-process-signal-history nil
544 "A list with the signal history.")
546 (defvar View-process-field-name-descriptions nil
547 "Help list with the descriptions of ps fields.
548 Don't change it by hand!
549 The variable is initialized each time after running ps.
550 The variable is buffer local.")
552 (make-variable-buffer-local 'View-process-field-name-descriptions)
554 (defvar View-process-field-name-descriptions-general
556 ("m" "Mark column of the View Processes Mode.") ; not a real field name
557 ("ADDR" "The memory address of the process. ")
558 ("%CPU" "CPU usage in percentage.")
559 ("%MEM" "Real Memory usage in percentage.")
560 ("COMMAND" "Command Name.")
562 ("0" "0=not in main memory.")
563 ("1" "1=in main memory.")
564 ("2" "2=system process.")
565 ("4" "4=blocked in the main memory.")
566 ("10" "10=swapped out.")
567 ("20" "20=controlled by another one.")))
568 ("NI" "UNIX nice value, a positive value means less CPU time.")
569 ("PAGEIN" "Number of major page faults.")
570 ("PGID" "Process group id. ")
571 ("PID" "The process id.")
572 ("PPID" "The process id of the parent process.")
573 ("PRI" "Priority, a big value is a small priority.")
574 ("RSS" "Real (resident set) size, KBytes of program in memory.")
575 ("SHARE" "Shared memory")
576 ("SID" "ID of the session to which the process belongs. ")
577 ("SIZE" "Virtual image size, size of text+data+stack (in KByte ?).")
578 ("START" "Start time.")
582 ("D" "D=un-interruptible sleep (eg disk or NFS I/O). ")
583 ("T" "T=stopped or traced. ")
584 ("Z" "Z=zombie (terminated). ")
585 ("W" "W=waiting on an event. ")
586 ("I" "I=intermediate status. ")
587 ("N" "N=started with nice. ")
589 ("SWAP" "Kilobytes (with -p pages) on swap device.")
590 ("TIME" "Elapsed process time.")
591 ("TPGID" "Process group id of the associated terminal. ")
592 ("TRS" "Text resident size.")
593 ("TT" ("Dialog station. " ("?" "?=No dialog station")))
594 ("TTY" ("Dialog station. " ("?" "?=No dialog station")))
596 ("USER" "Owner of the process.")
597 ("WCHAN" "Name of the kernel function where the process is sleeping.")
599 "Help list with the descriptions of ps fields.
600 This is a general list which should be applicable for many systems.
601 This list will only be used if there is no entry in a special
602 list for the system.")
604 (defvar View-process-insert-blank-alist
605 '(("SZ" behind-predecessor 0)
606 ("SIZE" behind-predecessor 0)
607 ("RSS" behind-predecessor 0)
609 "Determines places in the output where a blank should be inserted.
610 It is an alist and each sublist has the following structure:
611 (field-name position-descriptor offset)
612 The field-name is a string with the name of the field.
613 The position-descriptor determines a position. It has one of the
615 `in-front' => insert in front of the field.
616 `in-front-successor' => insert in front of the successor of the field.
617 `behind' => insert behind of the field.
618 `behind-predecessor' => insert behind the predecessor of the field.
619 The offset is an integer , which specifies an offset.")
621 (defvar View-process-mode-syntax-table nil
622 "Syntax table for the `View-process-mode'.")
624 (if (not View-process-mode-syntax-table)
626 (setq View-process-mode-syntax-table (make-syntax-table))
629 (modify-syntax-entry i "w" View-process-mode-syntax-table)
631 (modify-syntax-entry ?, "w" View-process-mode-syntax-table)
632 (modify-syntax-entry ?. "w" View-process-mode-syntax-table)
635 (modify-syntax-entry i "w" View-process-mode-syntax-table)
639 (modify-syntax-entry i "w" View-process-mode-syntax-table)
641 (modify-syntax-entry ?\\ "w" View-process-mode-syntax-table)
642 (modify-syntax-entry ?^ "w" View-process-mode-syntax-table)
643 (modify-syntax-entry ?` "w" View-process-mode-syntax-table)
644 (modify-syntax-entry ?' "w" View-process-mode-syntax-table)
645 (modify-syntax-entry ?~ "w" View-process-mode-syntax-table)
646 (modify-syntax-entry ?¡ "w" View-process-mode-syntax-table)
649 (defvar View-process-digit-bindings-send-signal nil
650 "If t, the digit keys 1 to 9 will be bound to send signal commands.")
652 (defvar View-process-mode-mark-map nil
653 "Local subkeymap for View-process-mode buffers.")
655 (if View-process-mode-mark-map
657 (setq View-process-mode-mark-map (make-keymap))
658 (define-key View-process-mode-mark-map "m" 'View-process-mark-current-line)
659 (define-key View-process-mode-mark-map "u" 'View-process-unmark-current-line)
660 (define-key View-process-mode-mark-map "U" 'View-process-unmark-all)
661 (define-key View-process-mode-mark-map "c"
662 'View-process-mark-children-in-current-line)
663 (define-key View-process-mode-mark-map "l" 'View-process-reset-last-marks)
666 (defvar View-process-mode-i-map nil
667 "Local subkeymap for View-process-mode buffers.")
669 (if View-process-mode-i-map
671 (setq View-process-mode-i-map (make-keymap))
672 (define-key View-process-mode-i-map "s" 'View-process-start-itimer)
673 (define-key View-process-mode-i-map "d" 'View-process-delete-itimer)
676 (defvar View-process-mode-comma-map nil
677 "Local subkeymap for View-process-mode buffers.")
679 (if View-process-mode-comma-map
681 (setq View-process-mode-comma-map (make-keymap))
682 (define-key View-process-mode-comma-map "k"
683 'View-process-send-signal-to-processes-with-mark)
684 (define-key View-process-mode-comma-map "a"
685 'View-process-renice-processes-with-mark))
687 (defvar View-process-mode-period-map nil
688 "Local subkeymap for View-process-mode buffers.")
690 (if View-process-mode-period-map
692 (setq View-process-mode-period-map (make-keymap))
693 (define-key View-process-mode-period-map "f"
694 'View-process-filter-region-by-current-field)
695 (define-key View-process-mode-period-map "l"
696 'View-process-filter-region)
697 (define-key View-process-mode-period-map "s"
698 'View-process-sort-region-by-current-field)
699 (define-key View-process-mode-period-map "r"
700 'View-process-reverse-region)
701 (define-key View-process-mode-period-map "k"
702 'View-process-send-signal-to-processes-in-region)
703 (define-key View-process-mode-period-map "a"
704 'View-process-renice-processes-in-region)
705 (define-key View-process-mode-period-map "v"
706 'View-process-status))
709 (defvar View-process-mode-map nil
710 "Local keymap for View-process-mode buffers.")
712 (if View-process-mode-map
714 (setq View-process-mode-map (make-keymap))
715 (define-key View-process-mode-map "q" 'View-process-quit)
716 (define-key View-process-mode-map "V" 'View-process-display-version)
717 (define-key View-process-mode-map " " 'scroll-up)
718 (define-key View-process-mode-map "b" 'scroll-down)
719 (define-key View-process-mode-map "t" 'View-process-toggle-truncate-lines)
720 (define-key View-process-mode-map "u" 'View-process-status-update)
721 (define-key View-process-mode-map "U"
722 'View-process-remove-all-filter-and-sorter)
723 (define-key View-process-mode-map "g" 'revert-buffer)
724 ; (define-key View-process-mode-map "v" 'View-process-status)
725 (define-key View-process-mode-map "v" 'view-processes)
726 (define-key View-process-mode-map "f"
727 'View-process-filter-by-current-field-g)
728 (define-key View-process-mode-map "F"
729 'View-process-filter-output-by-current-field)
730 (define-key View-process-mode-map "l"
731 'View-process-filter-g)
732 (define-key View-process-mode-map "L"
733 'View-process-filter-output)
734 (define-key View-process-mode-map "s"
735 'View-process-sort-by-current-field-g)
736 (define-key View-process-mode-map "S"
737 'View-process-sort-output-by-current-field)
738 (define-key View-process-mode-map "r"
739 'View-process-reverse-g)
740 (define-key View-process-mode-map "R"
741 'View-process-reverse-output)
742 (define-key View-process-mode-map "k"
743 'View-process-send-signal-to-processes-g)
744 (define-key View-process-mode-map "K"
745 'View-process-send-signal-to-process-in-line)
746 (define-key View-process-mode-map "a"
747 'View-process-renice-processes-g)
748 (define-key View-process-mode-map "A"
749 'View-process-renice-process-in-line)
750 ; (define-key View-process-mode-map "k"
751 ; 'View-process-send-signal-to-process)
752 (define-key View-process-mode-map "?"
753 'View-process-which-field-name)
754 (define-key View-process-mode-map "h"
755 'View-process-show-field-names)
756 (define-key View-process-mode-map "e"
757 'View-process-display-emacs-pid)
758 (define-key View-process-mode-map "w" 'View-process-show-pid-and-command)
759 (define-key View-process-mode-map "n" 'View-process-next-field)
760 (define-key View-process-mode-map "p" 'View-process-previous-field)
761 (define-key View-process-mode-map "<" 'View-process-output-start)
762 (define-key View-process-mode-map ">" 'View-process-output-end)
763 (define-key View-process-mode-map [return]
764 'View-process-goto-first-field-next-line)
765 (define-key View-process-mode-map "M" 'View-process-submit-bug-report)
766 (define-key View-process-mode-map "m" View-process-mode-mark-map)
767 (define-key View-process-mode-map "." View-process-mode-period-map)
768 (define-key View-process-mode-map "," View-process-mode-comma-map)
769 (define-key View-process-mode-map "i" View-process-mode-i-map)
772 (defvar View-process-pulldown-menu-name "Processes"
773 "Name of the pulldown menu in the `View-process-mode'.")
775 (defvar View-process-pulldown-menu nil
776 "Pulldown menu list for the `View-process-mode'.")
778 (defvar View-process-region-menu nil
779 "Menu list for the `View-process-mode', used if a region is active.")
781 (defvar View-process-marked-menu nil
782 "Menu list for the `View-process-mode', used if marked lines exists.
783 Not used if a region is active.")
785 (defvar View-process-non-region-menu nil
786 "Menu list for the `View-process-mode', used if a region is not active.")
788 (defvar View-process-mode-name "Processes"
789 "Name of the `view process mode'.")
791 (defun View-process-make-field-position-alist-1 ()
792 "Internal function of View-process-make-field-position-alist."
793 (if (>= (point) View-process-header-end)
796 (skip-chars-forward " ")
797 (setq start (current-column))
798 (skip-chars-forward "^ ")
799 (setq end (current-column))
800 (cons (list start end)
801 (View-process-make-field-position-alist-1))))
804 (defun View-process-make-field-position-alist ()
805 "Return an alist with the start and end positions of each field.
806 The list looks like ((start1 end1) (start2 end2) ...)."
809 (goto-char View-process-header-start)
810 (View-process-make-field-position-alist-1)))
812 (defun View-process-overwrite-chars-in-region (begin end char)
813 "Overwrite region between BEGIN and END with CHAR."
814 (let ((region-begin (if (< begin end) begin end))
815 (region-end (if (> end begin) end begin)))
817 (goto-char region-begin)
818 (while (> region-end (point))
820 (View-process-insert-and-inherit char)))))
822 (defun View-process-replaces-blanks-in-the-fields-of-this-line
823 (field-position-alist)
824 "Replace the blanks in the fields of this line with underscores.
825 FIELD-POSITION-ALIST is an alist with the name and the
826 approximated start and end positions of each field."
827 (if (cdr field-position-alist) ; don't change the last field
828 (let ((field-start (+ (View-process-return-beginning-of-line)
829 (car (car field-position-alist))))
830 (field-end (+ (View-process-return-beginning-of-line)
831 (car (cdr (car field-position-alist)))))
832 (next-field-start (+ (View-process-return-beginning-of-line)
834 (cdr field-position-alist))))))
835 (goto-char field-start)
836 (skip-chars-forward " ")
837 (if (> (point) field-end)
838 (progn (goto-char field-start)
840 (View-process-insert-and-inherit "_"))
841 (let ((search-result (search-forward-regexp "[ ]+" field-end t))
842 (match-beginning nil))
844 (if (not (= search-result field-end))
845 (View-process-overwrite-chars-in-region (match-beginning 0)
848 (setq match-beginning (match-beginning 0))
849 (if (and (search-forward-regexp "[^ ]+" next-field-start t)
850 (not (eq (point) next-field-start)))
851 (View-process-overwrite-chars-in-region
856 (View-process-replaces-blanks-in-the-fields-of-this-line
857 (cdr field-position-alist)))))
859 (defun View-process-replaces-blanks-in-fields ()
860 "Replace the blanks in fields with underscores."
862 (save-window-excursion
863 (let ((field-position-alist (View-process-make-field-position-alist))
864 (read-only buffer-read-only))
865 (setq buffer-read-only nil)
866 (goto-char View-process-output-start)
867 (while (< (point) View-process-output-end)
869 (View-process-replaces-blanks-in-the-fields-of-this-line
870 field-position-alist)
872 (setq buffer-read-only read-only)))))
874 (defun View-process-replaces-blanks-in-fields-if-necessary ()
875 "Replace blanks in fields, if necessary.
876 For that it checks `View-process-field-blanks-already-replaced'."
877 (if View-process-field-blanks-already-replaced
879 (View-process-replaces-blanks-in-fields)
880 (setq View-process-field-blanks-already-replaced t)))
882 (defun View-process-insert-column-in-region (char
888 "Insert the CHAR at the COLUMN in the region from BEGIN to END.
889 The first line must have sufficient columns. No tabs are allowed.
890 If the optional argument OVERWRITE is non-nil, then the CHAR
891 overwrites the char in the COLUMN.
892 The optional argument NOT-LOOKING-AT is nil or a regular expression.
893 In the second case the insertion will only be done if NOT-LOOKING-AT
894 isn't a string starting at the column."
896 (let ((no-of-lines (count-lines begin end))
900 (while (<= line no-of-lines)
901 (forward-char column)
902 (if (not (= (current-column) column))
903 (View-process-insert-and-inherit
904 (make-string (- column (current-column)) ? )))
908 (View-process-insert-and-inherit char))
909 (if (or (not not-looking-at)
910 (not (looking-at not-looking-at)))
912 (View-process-insert-and-inherit char)
916 (setq line (1+ line))))))
918 (defun View-process-insert-blank-in-column (column
921 "Insert a blank in all lines of the ps output in column COLUMN.
922 If OVERWRITE is non-nil, then it overwrites the old column char.
923 The optional argument NOT-LOOKING-AT is nil or a regular expression.
924 In the second case the insertion will only be done if NOT-LOOKING-AT
925 isn't a string starting at the column."
926 (let ((read-only buffer-read-only))
927 (setq buffer-read-only nil)
928 (View-process-insert-column-in-region ?
930 View-process-header-start
931 View-process-output-end
934 (setq View-process-output-end (point-max))
935 (setq buffer-read-only read-only)))
937 ;(defun View-process-insert-blanks-at-line-start ()
938 ; "Inserts some blanks at the beginning of each output line.
939 ;This space is used for the marks."
941 ; (goto-char View-process-header-start)
944 ; (while (< (point) View-process-output-end)
948 (defun View-process-insert-blanks-at-line-start ()
949 "Insert some blanks at the beginning of each output line.
950 This space is used for the marks."
952 (goto-char View-process-output-end)
954 (while (> (point) View-process-header-start)
959 (defun View-process-return-position (field-name position-descriptor)
960 "Return a position depending on the FIELD-NAME and the POSITION-DESCRIPTOR.
961 The POSITION-DESCRIPTOR must be one of the 4 values: `in-front',
962 `in-front-successor', `behind' and `behind-predecessor'.
963 If the FIELD-NAME isn't in the header-line, then it return nil."
965 (goto-char View-process-header-start)
967 (if (search-forward field-name (View-process-return-end-of-line) t)
968 (cond ((eq position-descriptor 'behind-predecessor)
969 (goto-char (match-beginning 0))
970 (skip-chars-backward " ")
972 ((eq position-descriptor 'behind)
974 ((eq position-descriptor 'in-front)
975 (goto-char (match-beginning 0))
977 ((eq position-descriptor 'in-front-successor)
978 (skip-chars-forward " ")
979 (current-column))))))
981 (defun View-process-split-merged-fields (insert-blank-alist)
982 "Try to split merged fields.
983 At the moment this is done by inserting a blank between fields,
984 which are often merged together. The fields are determined by the
985 alist INSERT-BLANK-ALIST."
986 (cond (insert-blank-alist
987 (let ((position (View-process-return-position
988 (car (car insert-blank-alist))
989 (car (cdr (car insert-blank-alist))))))
991 (View-process-insert-blank-in-column
993 (car (cdr (cdr (car insert-blank-alist)))))
996 (View-process-split-merged-fields (cdr insert-blank-alist)))
999 (defun View-process-replace-colons-with-blanks ()
1000 "Replace colons with blanks if a colon is also in the header line.
1001 This fixes the output of the IRIX ps on SGIs."
1003 (goto-char View-process-header-start)
1004 (while (search-forward ":" (View-process-return-end-of-line) t)
1005 (View-process-insert-blank-in-column (current-column)
1008 (defun View-process-mode ()
1009 "Mode for displaying and killing processes.
1010 The mode has the following key bindings:
1011 \\{View-process-mode-map}.
1013 The first column of each output line will be used to display marked lines.
1014 The following mark signs are possible (one can change them by changing
1015 the variables in the second column of the following table):
1017 Sign Variable Description
1018 _ View-process-no-mark Process isn't marked
1019 * View-process-single-line-mark The normal mark.
1020 C View-process-child-line-mark Marked as a child of P (see also P)
1021 K View-process-signal-line-mark Used during signaling
1022 N View-process-renice-line-mark Used during renicing
1023 P View-process-parent-line-mark Marked as the parent of P (see also C)
1024 s View-process-signaled-line-mark Process was signaled or reniced.
1026 The signal and renice commands are working also on marked processes!"
1027 ; (kill-all-local-variables)
1028 (make-local-variable 'revert-buffer-function)
1029 (setq revert-buffer-function 'View-process-revert-buffer)
1030 (View-process-change-display-type View-process-display-with-2-windows)
1031 (use-local-map View-process-mode-map)
1032 (set-syntax-table View-process-mode-syntax-table)
1033 (setq major-mode 'View-process-mode
1034 mode-name View-process-mode-name)
1035 ; (View-process-replaces-blanks-in-fields)
1036 (setq View-process-deleted-lines nil)
1037 (View-process-call-sorter-and-filter View-process-actual-sorter-and-filter)
1038 (setq truncate-lines View-process-truncate-lines)
1039 (View-process-install-pulldown-menu)
1040 ; (View-process-install-mode-motion)
1041 (View-process-hide-header (and View-process-display-with-2-windows
1042 View-process-hide-header))
1043 (View-process-install-font-lock)
1044 (View-process-install-mode-motion)
1045 (run-hooks 'View-process-mode-hook)
1048 (defun View-process-build-field-name-list ()
1049 "Return an alist with the field names and the field number.
1050 The list looks like ((\"USER\" 1) (\"PID\" 2) (\"COMMAND\" 3))."
1051 (goto-char View-process-header-start)
1053 (setq View-process-field-names '())
1055 (while (<= (point) View-process-header-end)
1056 (setq View-process-field-names (cons (list (current-word) i)
1057 View-process-field-names))
1061 (defun View-process-field-name-exists-p (field-name)
1062 "Return non-nil if the field FIELD-NAME exists."
1063 (assoc field-name View-process-field-names))
1065 (defun View-process-translate-field-name-to-position (field-name)
1066 "Return the position of the field with the name FIELD-NAME."
1067 (car (cdr (assoc field-name View-process-field-names)))
1070 (defun View-process-translate-field-position-to-name (position)
1071 "Return the field name of the field with the position POSITION."
1072 (if (> position View-process-max-fields)
1073 (car (View-process-assoc-2th View-process-max-fields
1074 View-process-field-names))
1075 (car (View-process-assoc-2th position View-process-field-names))
1078 (defun View-process-get-system-type-from-host-list (host-name)
1079 "Return nil, or the system type of the host with the name HOST-NAME."
1080 (car (cdr (assoc host-name View-process-host-names-and-system-types))))
1082 (defun View-process-put-system-type-in-host-list (host-name system-type)
1083 "Puts the HOST-NAME and the SYSTEM-TYPE in a special host list.
1084 The list has the name `View-process-host-names-and-system-types'."
1085 (if (not (member (list host-name system-type)
1086 View-process-host-names-and-system-types))
1087 (setq View-process-host-names-and-system-types
1088 (cons (list host-name system-type)
1089 View-process-host-names-and-system-types))))
1091 (defun View-process-bsd-or-system-v (&optional remote-host)
1092 "This function determines if the system is a BSD or a System V.
1093 For that it uses the ps command.
1094 If REMOTE-HOST is non-nil, then the system of the REMOTE-HOST will
1097 (if (eq 0 (call-process View-process-rsh-command
1102 (concat View-process-status-command
1107 (if (eq 0 (call-process View-process-status-command
1115 (defun View-process-program-exists-p (program &optional remote-host)
1116 "Return t if the PROGRAM exists.
1117 If REMOTE-HOST is non-nil, then the program will be searched remote
1120 (or (= 0 (call-process View-process-rsh-command
1125 (concat View-process-test-command
1127 View-process-test-switches
1130 (= 0 (call-process View-process-rsh-command
1135 (concat View-process-test-command
1137 View-process-test-switches
1141 (= 0 (call-process View-process-rsh-command
1146 (concat View-process-test-command
1148 View-process-test-switches
1152 (or (= 0 (call-process View-process-test-command
1156 View-process-test-switches
1158 (= 0 (call-process View-process-test-command
1162 View-process-test-switches
1163 (concat "/bin/" program)))
1164 (= 0 (call-process View-process-test-command
1168 View-process-test-switches
1169 (concat "/usr/bin/" program))))))
1171 (defun View-process-search-system-type-in-system-list-1 (system-type
1173 "Internal function of `View-process-search-system-type-in-system-list'."
1174 (cond ((not system-list) nil)
1175 ((equal system-type (car (car system-list)))
1176 (cons (car system-list)
1177 (View-process-search-system-type-in-system-list-1
1179 (cdr system-list))))
1180 (t (View-process-search-system-type-in-system-list-1 system-type
1184 (defun View-process-search-system-type-in-system-list (system-type system-list)
1185 "Search the SYSTEM-TYPE in SYSTEM-LIST.
1186 It returns the entry or nil if the SYSTEM-TYPE isn't in the list.
1187 If more then one entry with the same SYSTEM-TYPE are found, then the
1188 version number is also checked. If the version number isn't in the
1189 list, then nil is returned."
1190 (let ((system-type-entries (View-process-search-system-type-in-system-list-1
1193 (if system-type-entries
1194 (if (= 1 (length system-type-entries))
1195 (car system-type-entries)
1196 (View-process-assoc-2th (car (cdr system-type)) system-type-entries))
1200 (defun View-process-generalize-system-type (system-type &optional remote-host)
1201 "Generalize the SYSTEM-TYPE.
1202 Determines if the system is in the `View-process-specific-system-list'
1203 and if it is a BSD or a System V system. It returns a list which looks
1204 like the following: (<system-type> <version-no> <bsd-or-system-v>).
1205 The elements <system-type> and <version-no> are set to nil if the
1206 <system-type> isn't in the `View-process-specific-system-list'. In that
1207 case the third element (<bsd-or-system-v>) is determined with the help
1208 of the ps output. if REMOTE-HOST is non-nil, the the ps command to check
1209 the system type is run on the remote host REMOTE-HOST."
1210 (let ((new-system-type (View-process-search-system-type-in-system-list
1212 View-process-specific-system-list)))
1215 (list nil nil (View-process-bsd-or-system-v)))))
1217 (defun View-process-get-local-system-type ()
1218 "Return the system type of the local host."
1219 (let ((system-type (View-process-get-system-type-from-host-list
1221 (if (not system-type) ; t if the host isn't in the list
1223 (if (View-process-program-exists-p View-process-uname-command)
1225 (let ((buffer (generate-new-buffer "*system-type*")))
1226 (call-process View-process-uname-command
1230 View-process-uname-switches)
1233 (setq system-type (downcase (current-word)))
1236 (list system-type (downcase (current-word))))
1237 (kill-buffer buffer)
1238 ;; determine if the system is in the
1239 ;; View-process-specific-system-list and if it is
1240 ;; a BSD or a System V system;
1241 ;; The system type will be set to nil,
1242 ;; if it isn't in the list
1243 (setq system-type (View-process-generalize-system-type
1246 (setq system-type (list nil nil (View-process-bsd-or-system-v))))
1247 (View-process-put-system-type-in-host-list (system-name)
1252 (defun View-process-get-remote-system-type ()
1253 "Return the system type of the remote host `View-process-remote-host'."
1254 (let ((system-type (View-process-get-system-type-from-host-list
1255 View-process-remote-host)))
1256 (if system-type ; nil if the host isn't in the list
1258 (if (View-process-program-exists-p View-process-uname-command
1259 View-process-remote-host)
1260 (let ((buffer (generate-new-buffer "*system-type*")))
1262 (call-process View-process-rsh-command
1266 View-process-remote-host
1267 (concat View-process-uname-command
1269 View-process-uname-switches))
1272 (setq system-type (downcase (current-word)))
1275 (list system-type (downcase (current-word))))
1276 (kill-buffer buffer)
1277 ;; determine if the system is in the
1278 ;; View-process-specific-system-list and if it is
1279 ;; a BSD or a System V system;
1280 ;; The system type will be set to nil,
1281 ;; if it isn't in the list
1282 (setq system-type (View-process-generalize-system-type
1284 View-process-remote-host))
1286 (setq system-type (list nil nil (View-process-bsd-or-system-v
1287 View-process-remote-host))))
1288 (View-process-put-system-type-in-host-list View-process-remote-host
1292 (defun View-process-get-system-type ()
1293 "Return the type of the system on which ps was executed."
1294 (if View-process-remote-host
1295 (View-process-get-remote-system-type)
1296 (View-process-get-local-system-type)
1299 (defun View-process-get-kill-signal-list (system-type)
1300 "Return a kill signal list for the SYSTEM-TYPE."
1301 (if (= 3 (length system-type))
1302 (if (string= "bsd" (nth 2 system-type))
1303 (if View-process-kill-signals-bsd
1304 View-process-kill-signals-bsd
1305 View-process-kill-signals-general)
1306 (if View-process-kill-signals-system-v
1307 View-process-kill-signals-system-v
1308 View-process-kill-signals-general))
1309 (if (eval (nth 4 system-type))
1310 (eval (nth 4 system-type))
1311 (if (string= "bsd" (nth 2 system-type))
1312 (if View-process-kill-signals-bsd
1313 View-process-kill-signals-bsd
1314 View-process-kill-signals-general)
1315 (if View-process-kill-signals-system-v
1316 View-process-kill-signals-system-v
1317 View-process-kill-signals-general)))))
1319 (defun View-process-get-field-name-description-list (system-type)
1320 "Return a field name description list for the SYSTEM-TYPE.
1321 It returns nil if no system specific list exists."
1322 (if (= 3 (length system-type))
1323 (if (string= "bsd" (nth 2 system-type))
1324 (if View-process-field-name-descriptions-bsd
1325 View-process-field-name-descriptions-bsd)
1326 (if View-process-field-name-descriptions-system-v
1327 View-process-field-name-descriptions-system-v))
1328 (if (eval (nth 3 system-type))
1329 (eval (nth 3 system-type))
1330 (if (string= "bsd" (nth 2 system-type))
1331 (if View-process-field-name-descriptions-bsd
1332 View-process-field-name-descriptions-bsd)
1333 (if View-process-field-name-descriptions-system-v
1334 View-process-field-name-descriptions-system-v)))))
1336 (defun View-process-init-internal-variables (use-last-sorter-and-filer)
1337 "Init internal variables.
1338 (without `View-process-header-start').
1339 If USE-LAST-SORTER-AND-FILER is t, then
1340 'View-process-actual-sorter-and-filter' will not be changed"
1341 ;; don't replace blanks now
1342 (setq View-process-field-blanks-already-replaced t)
1344 (goto-char View-process-header-start)
1346 (setq View-process-header-end (point))
1349 (setq View-process-output-start (point))
1350 (setq View-process-output-end (point-max))
1351 (goto-char View-process-header-end)
1353 (setq View-process-max-fields (View-process-current-field-number))
1354 (View-process-build-field-name-list)
1355 (setq View-process-system-type (View-process-get-system-type))
1356 (setq View-process-kill-signals (View-process-get-kill-signal-list
1357 View-process-system-type))
1358 (setq View-process-field-name-descriptions
1359 (View-process-get-field-name-description-list View-process-system-type)
1361 ;; Replace the blanks the next time if it is necessary
1362 (setq View-process-field-blanks-already-replaced nil)
1363 (if (not use-last-sorter-and-filer)
1364 (setq View-process-actual-sorter-and-filter
1365 View-process-sorter-and-filter))
1367 (if View-process-pid-mark-alist
1369 (setq View-process-last-pid-mark-alist View-process-pid-mark-alist)
1370 (setq View-process-pid-mark-alist nil)))
1373 (defun View-process-insert-short-key-descriptions ()
1374 "Insert short key descriptions at the current point.
1375 If `View-process-display-short-key-descriptions' is nil, then
1376 nothing will be inserted."
1377 (if View-process-display-short-key-descriptions
1378 (let ((local-map (current-local-map)))
1379 (use-local-map View-process-mode-map)
1381 (substitute-command-keys
1383 " \\[view-processes]: new output "
1384 "\\[View-process-status]: new output with new options "
1385 " \\[revert-buffer]: update output \n"
1386 " \\[View-process-filter-by-current-field-g]: field filter "
1387 "\\[View-process-filter-g]: line filter "
1388 "\\[View-process-sort-by-current-field-g]: sort "
1389 "\\[View-process-reverse-g]: reverse "
1390 "\\[View-process-send-signal-to-processes-g]: send signal "
1391 "\\[View-process-quit]: quit\n")))
1392 (use-local-map local-map))))
1394 (defun View-process-insert-uptime (&optional remote-host)
1395 "Insert uptime information at the current point.
1396 if `View-process-display-uptime' is nil, then nothing will be inserted.
1397 If REMOTE-HOST is non-nil, then its the name of the remote host."
1398 (if View-process-display-uptime
1402 (call-process View-process-rsh-command
1407 View-process-uptime-command)
1408 (call-process View-process-uptime-command
1413 (defun View-process-insert-title-lines (command-switches
1415 use-last-sorter-and-filter)
1416 "Insert the title lines in the output lines.
1417 REMOTE-HOST is nil or the name of the host on which the
1418 ps command was executed. USE-LAST-SORTER-AND-FILTER determines if
1419 the last sorter and filter (from `View-process-actual-sorter-and-filter')
1421 (insert (or remote-host (system-name) "")
1422 ;;(getenv "HOST") (getenv "HOSTNAME") "")
1424 (current-time-string)
1426 View-process-status-command
1430 (View-process-insert-uptime remote-host)
1431 (View-process-insert-short-key-descriptions)
1432 (if (or (and use-last-sorter-and-filter
1433 View-process-actual-sorter-and-filter)
1434 View-process-sorter-and-filter)
1436 "This output is filtered! Look at `View-process-sorter-and-filter'.\n"))
1438 (setq View-process-ps-header-window-size
1439 (+ View-process-ps-header-window-offset
1440 (count-lines (point-min) (point))
1441 (if (and (View-process-xemacs-p)
1442 (not (View-process-lemacs-p))
1443 View-process-header-mode-line-off)
1447 (defun View-process-search-header-line-1 (header-detection-list
1449 "Internal function of `View-process-search-header-line'."
1450 (cond (header-detection-list
1451 (goto-char View-process-header-start)
1452 (if (search-forward (car header-detection-list) nil t)
1453 (setq View-process-header-start
1454 (View-process-return-beginning-of-line))
1455 (View-process-search-header-line-1 (cdr header-detection-list)
1457 (t (setq mode-motion-hook nil) ; otherwise emacs hangs
1458 (if no-error-message
1460 (error (concat "ERROR: No header line detected! "
1461 "Look at View-process-header-line-detection-list!")
1465 (defun View-process-search-header-line (&optional no-error-message)
1466 "Searcg the header line and set `View-process-header-start'.
1467 The header line must have at least one of the words of the list
1468 `View-process-header-line-detection-list'.
1469 If NO-ERROR-MESSAGE is t and no header-line is found, then only
1470 nil (without an error message) will be returned."
1472 (View-process-search-header-line-1 View-process-header-line-detection-list
1476 (defun View-process-save-position ()
1477 "Save the current line and column in a cons cell and return it."
1480 (if (< View-process-header-start (point-max))
1481 (cons (- (count-lines (or View-process-header-start (point-min))
1483 (if (= 0 (current-column))
1489 (defun View-process-goto-position (position)
1490 "Set the point to the POSITION.
1491 POSITION is a cons cell with a line number and a column."
1495 (goto-char View-process-header-start)
1496 (forward-line (car position))
1497 (move-to-column (cdr position) t)
1498 ; (setq temporary-goal-column (cdr position)) ; doesn't work :-(
1502 (defun View-process-status (command-switches
1503 &optional remote-host
1504 use-last-sorter-and-filter)
1505 "Prints a list with processes in the buffer `View-process-buffer-name'.
1506 COMMAND-SWITCHES is a string with the command switches (ie: -aux).
1507 IF the optional argument REMOTE-HOST is given, then the command will
1508 be executed on the REMOTE-HOST. If an prefix arg is given, then the
1509 function asks for the name of the remote host.
1510 If USE-LAST-SORTER-AND-FILTER is t, then the last sorter and filter
1511 commands are used. Otherwise the sorter and filter from the list
1512 'View-process-sorter-and-filter' are used."
1514 (let ((View-process-stop-motion-help t))
1516 (read-string "Command switches: "
1517 (or View-process-status-last-command-switches
1518 (if (bufferp (get-buffer View-process-buffer-name))
1521 'View-process-status-last-command-switches
1522 (buffer-local-variables
1523 (get-buffer View-process-buffer-name)))))
1524 (if (string= "bsd" (View-process-bsd-or-system-v))
1525 View-process-status-command-switches-bsd
1526 View-process-status-command-switches-system-v))
1527 'View-process-status-history)
1528 (if current-prefix-arg
1529 (setq View-process-remote-host
1530 (read-string "Remote host name: "
1531 View-process-remote-host
1532 'View-process-remote-host-history))
1533 (setq View-process-remote-host nil)))))
1534 (View-process-save-old-window-configuration)
1535 (let ((buffer (get-buffer-create View-process-buffer-name))
1537 ; (point-after-ps nil))
1538 (if (window-minibuffer-p (selected-window))
1540 (switch-to-buffer buffer))
1542 ;; set switches for the next view process command
1543 (setq View-process-status-last-command-switches command-switches)
1544 (if (string= "bsd" (View-process-bsd-or-system-v))
1545 (setq View-process-status-command-switches-bsd command-switches)
1546 (setq View-process-status-command-switches-system-v command-switches))
1548 (setq buffer-read-only nil)
1549 (if (not (= (point-min) (point-max)))
1551 (setq position (View-process-save-position))
1552 ; (setq point-after-ps (point-min))
1553 ; (setq point-after-ps (point))
1555 (View-process-insert-title-lines command-switches
1557 use-last-sorter-and-filter)
1558 (setq View-process-header-start (point))
1560 (call-process View-process-rsh-command
1565 (concat View-process-status-command
1568 (call-process View-process-status-command
1573 (View-process-search-header-line)
1574 (setq View-process-output-end (point-max))
1575 (View-process-replace-colons-with-blanks)
1576 (View-process-insert-blanks-at-line-start)
1577 (View-process-split-merged-fields View-process-insert-blank-alist)
1578 (View-process-init-internal-variables use-last-sorter-and-filter)
1579 (View-process-highlight-header-line)
1580 (goto-char View-process-output-start)
1581 (View-process-goto-position position)
1582 ; (goto-char (cond ((> point-after-ps (point-max)) (point-max))
1583 ; ((= point-after-ps (point-min)) View-process-output-start)
1584 ; ((< point-after-ps View-process-output-start)
1585 ; View-process-output-start)
1586 ; (t point-after-ps)))
1587 (setq buffer-read-only t)
1588 (let ((View-process-stop-motion-help t))
1589 ; (setq View-process-stop-motion-help t)
1591 ; (setq View-process-stop-motion-help nil)
1592 ; (View-process-redraw) ; only the first time (fixes an Emacs 19 bug)
1596 (defun View-process-status-update ()
1597 "Run `View-process-status' with the last switches
1598 and sorter and filter commands."
1600 (if View-process-status-last-command-switches
1601 (View-process-status View-process-status-last-command-switches
1602 View-process-remote-host
1604 (error "ERROR: No view process buffer exists for update!")))
1606 (defun view-processes (&optional remote-host)
1607 "Prints a list with processes in the buffer `View-process-buffer-name'.
1608 It calls the function `View-process-status' with default switches.
1609 As the default switches on BSD like systems the value of the variable
1610 `View-process-status-command-switches-bsd' is used.
1611 On System V like systems the value of the variable
1612 `View-process-status-command-switches-system-v' is used.
1613 IF the optional argument REMOTE-HOST is given, then the command will
1614 be executed on the REMOTE-HOST. If an prefix arg is given, then the
1615 function asks for the name of the remote host."
1617 (let ((View-process-stop-motion-help t))
1618 (list (if current-prefix-arg
1619 (setq View-process-remote-host
1620 (read-string "Remote host name: "
1621 View-process-remote-host
1622 'View-process-remote-host-history))
1623 (setq View-process-remote-host nil)))))
1624 (if (string= "bsd" (nth 2 (View-process-get-system-type)))
1625 (View-process-status View-process-status-command-switches-bsd
1626 View-process-remote-host)
1627 (View-process-status View-process-status-command-switches-system-v
1630 ;;; itimer functions (to repeat the ps output)
1632 (defun View-process-status-itimer-function ()
1633 "Itimer function for updating the ps output."
1635 (save-window-excursion
1636 (View-process-status-update)))
1637 ;;(View-process-start-itimer)
1643 (defun View-process-show-pid-and-command-or-field-name ()
1644 "Displays the pid and the command of the current line or the field name.
1645 If the point is at a blank, then the pid and the command of the current
1646 line are displayed. Otherwise the name of the field and its description
1649 (if (looking-at " ")
1650 (View-process-show-pid-and-command)
1651 (View-process-which-field-name)))
1653 (defun View-process-show-pid-and-command ()
1654 "Displays the pid and the command of the current line.
1655 It assumes, that the command is displayed at the end of the line."
1657 (if (>= (point) View-process-output-start)
1658 (message "PID= %s, %s"
1659 (View-process-get-pid-from-current-line)
1660 (View-process-get-field-value-from-current-line
1661 View-process-max-fields
1662 View-process-max-fields))))
1664 (defun View-process-show-field-names ()
1665 "Displays the name(s) of the ps output field(s).
1666 If the point is at a blank, then the header line with all field names
1667 is displayed. Otherwise only the name of the field at the point is
1670 (if (looking-at " ")
1671 (View-process-show-header-line)
1672 (View-process-which-field-name)))
1674 (defun View-process-show-header-line ()
1675 "Displays the header line in the buffer at the current line."
1677 (save-window-excursion
1678 (let ((header-line (save-restriction
1681 (buffer-substring View-process-header-start
1682 View-process-header-end)
1684 (momentary-string-display header-line
1685 (View-process-return-beginning-of-line)))))
1687 (defun View-process-which-field-name ()
1688 "Displays the name of the field under the point in the echo area."
1690 (if (>= (point) View-process-header-start)
1691 (let ((field-name (View-process-translate-field-position-to-name
1692 (View-process-current-field-number))))
1694 (View-process-replace-in-string
1699 (View-process-get-field-name-description field-name)))))))
1701 (defun View-process-get-field-name-description (field-name)
1702 "Return a string with a description of the ps output field FIELD-NAME."
1704 (or (car (cdr (assoc field-name
1705 View-process-field-name-descriptions)))
1706 (car (cdr (assoc field-name
1707 View-process-field-name-descriptions-general))))
1709 (if (stringp description)
1711 (concat (car description)
1712 (View-process-get-value-description
1713 (View-process-get-field-value-from-current-line
1714 (View-process-translate-field-name-to-position field-name)
1715 View-process-max-fields)
1716 (cdr description))))))
1718 (defun View-process-get-value-description (values value-descriptions)
1719 "Return a string with the description of the VALUES.
1720 VALUE-DESCRIPTIONS is an alist with the possible values and its
1722 (cond ((string= values "") "")
1723 ((or (eq (aref values 0) ?_) (eq (aref values 0) ? ))
1724 (View-process-get-value-description (substring values 1)
1725 value-descriptions))
1730 (substring values 0 (string-match "[ _]" values))
1731 value-descriptions)))
1732 (if (string-match "[ _]" values)
1733 (View-process-get-value-description
1734 (substring values (string-match "[ _]" values))
1741 (defun View-process-current-field-number ()
1742 "Return the field number of the point.
1743 The functions fails with an error message if the character under
1744 the point is a blank."
1745 (View-process-replaces-blanks-in-fields-if-necessary)
1747 (if (looking-at " ")
1748 (error "Point is on a blank and not in a field!")
1749 (if (and (eq (point) (point-max))
1750 (eq (current-column) 0))
1751 (error "Point is not in a field!")
1752 (let ((field-point (point))
1755 (skip-chars-forward " ")
1756 (while (>= field-point (point))
1758 (skip-chars-forward "^ ")
1759 (skip-chars-forward " "))
1762 (defun View-process-sort-fields-in-region (field
1765 &optional sort-function)
1766 "Sort lines in region by the ARGth field of each line.
1767 Fields are separated by whitespace and numbered from 1 up.
1768 With a negative arg, sorts by the ARGth field counted from the right.
1769 BEG and END specify region to sort.
1770 If the optional SORT-FUNCTION is nil, then the region is at first
1771 sorted with the function `sort-fields' and then with the function
1772 `sort-float-fields'. Otherwise a sort function like `sort-fields'
1774 (let ((position (View-process-save-position))
1775 ; (point (point)) ;; that's, because save-excursion
1776 ; (column (current-column)) ;; doesn't work :-(
1777 (field-no (if (< field View-process-max-fields)
1779 View-process-max-fields)))
1781 (eval (list sort-function field-no beg end))
1782 (sort-fields field-no beg end)
1783 (sort-float-fields field-no beg end))
1784 (View-process-goto-position position)))
1786 ; (goto-char (+ point (- column (current-column))))))
1788 (defun View-process-remove-sorter (sorter alist)
1789 "Remove the SORTER entry from the ALIST."
1790 (cond ((not alist) nil)
1791 ((eq sorter (car (car alist))) (cdr alist))
1792 (t (cons (car alist)
1793 (View-process-remove-sorter sorter (cdr alist))))))
1795 (defun View-process-sort-output-by-field (field-name
1796 &optional dont-remember)
1797 "Sort the ps output by the field FIELD-NAME.
1798 If DONT-REMEMBER is t, then the filter command isn't inserted
1799 in the `View-process-actual-sorter-and-filter' list."
1801 (let ((View-process-stop-motion-help t))
1803 (completing-read "Field Name for sorting: "
1804 View-process-field-names
1807 (car View-process-field-name-history)
1808 View-process-field-name-history))))
1809 (setq buffer-read-only nil)
1810 (View-process-sort-fields-in-region
1811 (View-process-translate-field-name-to-position field-name)
1812 View-process-output-start
1813 View-process-output-end)
1814 (setq buffer-read-only t)
1815 (if (not dont-remember)
1816 (setq View-process-actual-sorter-and-filter
1817 (append (View-process-remove-sorter
1819 (View-process-remove-sorter
1821 View-process-actual-sorter-and-filter))
1822 (list (list 'sort field-name))))))
1824 (defun View-process-sort-by-current-field-g ()
1825 "Sort the ps output by the field under the point.
1826 It is a generic interface to `View-process-sort-region-by-current-field'
1827 and `View-process-sort-output-by-current-field'.The first will be called
1828 if a region is active and the other one if not.
1829 With a prefix arg, it uses the NTH field instead of the current one."
1831 (if (View-process-region-active-p)
1832 (call-interactively 'View-process-sort-region-by-current-field)
1833 (call-interactively 'View-process-sort-output-by-current-field)))
1835 (defun View-process-sort-output-by-current-field (&optional nth dont-remember)
1836 "Sort the whole ps output by the field under the point.
1837 With a prefix arg, it uses the NTH field instead of the current one.
1838 If DONT-REMEMBER is t, then the filter command isn't inserted
1839 in the `View-process-actual-sorter-and-filter' list."
1841 (let ((field-number (if nth
1842 (if (and (>= nth 1) (<= nth View-process-max-fields))
1844 (error "ERROR: Wrong field number!"))
1845 (View-process-current-field-number))))
1846 (setq buffer-read-only nil)
1847 (View-process-sort-fields-in-region field-number
1848 View-process-output-start
1849 View-process-output-end)
1850 (setq buffer-read-only t)
1851 (if (not dont-remember)
1852 (setq View-process-actual-sorter-and-filter
1853 (append (View-process-remove-sorter
1855 (View-process-remove-sorter
1857 View-process-actual-sorter-and-filter))
1860 (View-process-translate-field-position-to-name
1861 field-number))))))))
1863 (defun View-process-sort-region-by-current-field (&optional nth)
1864 "Sort the region by the field under the point.
1865 With a prefix arg, it uses the NTH field instead of the current one."
1867 (let ((field-number (if nth
1868 (if (and (>= nth 1) (<= nth View-process-max-fields))
1870 (error "ERROR: Wrong field number!"))
1871 (View-process-current-field-number))))
1872 (setq buffer-read-only nil)
1873 (View-process-sort-fields-in-region
1876 (goto-char (region-beginning))
1877 (View-process-return-beginning-of-line))
1879 (goto-char (region-end))
1880 (View-process-return-end-of-line)))
1881 (setq buffer-read-only t)))
1883 (defun View-process-reverse-output (&optional dont-remember)
1884 "Reverses the whole output lines.
1885 If DONT-REMEMBER is t, then the filter command isn't inserted
1886 in the `View-process-actual-sorter-and-filter' list."
1888 (setq buffer-read-only nil)
1889 (let ((position (View-process-save-position)))
1890 ; (line (count-lines (point-min) (point)))
1891 ; (column (current-column)))
1892 (reverse-region View-process-output-start View-process-output-end)
1893 (View-process-goto-position position))
1895 ; (beginning-of-line)
1896 ; (forward-char column))
1897 (setq buffer-read-only t)
1898 (if (not dont-remember)
1899 (setq View-process-actual-sorter-and-filter
1900 (if (assq 'reverse View-process-actual-sorter-and-filter)
1901 (View-process-remove-sorter
1903 View-process-actual-sorter-and-filter)
1904 (append View-process-actual-sorter-and-filter
1905 (list (list 'reverse)))))))
1907 (defun View-process-reverse-region ()
1908 "Reverses the output lines in the region."
1910 (setq buffer-read-only nil)
1911 (let ((region-beginning (if (< (region-beginning) (region-end))
1914 (region-end (if (> (region-end) (region-beginning))
1916 (region-beginning)))
1917 (position (View-process-save-position)))
1918 ; (line (count-lines (point-min) (point)))
1919 ; (column (current-column)))
1920 (reverse-region (if (< region-beginning View-process-output-start)
1921 View-process-output-start
1922 (goto-char region-beginning)
1923 (View-process-return-beginning-of-line))
1924 (if (> region-end View-process-output-end)
1925 View-process-output-end
1926 (goto-char region-end)
1927 (View-process-return-end-of-line)))
1928 (View-process-goto-position position))
1930 ; (beginning-of-line)
1931 ; (forward-char column))
1932 (setq buffer-read-only t))
1934 (defun View-process-reverse-g ()
1935 "Reverses the output lines.
1936 It is a generic interface to `View-process-reverse-region'
1937 and `View-process-reverse-output'. The first will be called
1938 if a region is active and the other one if not."
1940 (if (View-process-region-active-p)
1941 (call-interactively 'View-process-reverse-region)
1942 (call-interactively 'View-process-reverse-output)))
1944 ;;; filter functions
1946 (defun View-process-delete-region (start end)
1947 "Stores deleted lines in `View-process-deleted-lines'."
1948 (setq View-process-deleted-lines
1949 (cons (buffer-substring start end)
1950 View-process-deleted-lines))
1951 (delete-region start end))
1953 (defun View-process-remove-all-filter-and-sorter ()
1954 "Undeletes all filtered lines from `View-process-deleted-lines'.
1955 It removes also all filter and sorter from the list
1956 `View-process-actual-sorter-and-filter'."
1958 (let ((buffer-read-only))
1959 (goto-char View-process-output-end)
1960 (mapcar '(lambda (line)
1962 View-process-deleted-lines)
1963 (setq View-process-output-end (point))
1964 (setq View-process-actual-sorter-and-filter nil)
1965 (goto-char View-process-output-start)))
1967 (defun View-process-filter-fields-in-region (regexp
1972 "Filters a region with a REGEXP in the field FIELD-NO.
1973 The region start is at BEG and the end at END. If FIELD-NO
1974 is nil, then the whole line is used. All lines which passes
1975 not the filter are deleted in the buffer if EXCLUDE is nil.
1976 Otherwise only these lines are not deleted."
1979 (let ((region-start (if (< beg end) beg end))
1980 (region-end (if (> beg end) beg end)))
1981 (if (< region-start View-process-output-start)
1982 (setq region-start View-process-output-start))
1983 (goto-char region-end)
1985 (while (>= (point) region-start)
1986 (if (string-match regexp
1987 (View-process-get-field-value-from-current-line
1989 View-process-max-fields))
1991 (View-process-delete-region
1992 (1- (View-process-return-beginning-of-line))
1993 (View-process-return-end-of-line))
1997 (View-process-delete-region
1998 (1- (View-process-return-beginning-of-line))
1999 (View-process-return-end-of-line)))
2002 (while (>= (point) region-start)
2003 (if (search-forward-regexp regexp
2004 (View-process-return-end-of-line) t)
2007 (View-process-delete-region
2008 (1- (View-process-return-beginning-of-line))
2009 (View-process-return-end-of-line))
2010 (beginning-of-line))
2014 (View-process-delete-region
2015 (1- (View-process-return-beginning-of-line))
2016 (View-process-return-end-of-line))
2017 (beginning-of-line))
2019 (goto-char region-start))
2020 (setq View-process-output-end (point-max))
2021 (if (> View-process-output-start View-process-output-end)
2024 (setq View-process-output-end View-process-output-start)))))
2026 (defun View-process-filter-output-by-field (field-name
2030 "Filter the whole output by the field FIELD-NAME with REGEXP.
2031 The matching lines are deleted if EXCLUDE is t. The non matching
2032 lines are deleted if EXCLUDE is nil. If you call this function
2033 interactive, then you can give a prefix arg to set EXCLUDE to non-nil.
2034 If DONT-REMEMBER is t, then the filter command isn't inserted
2035 in the `View-process-actual-sorter-and-filter' list."
2037 (let ((View-process-stop-motion-help t))
2039 (completing-read "Field Name for filtering: "
2040 View-process-field-names
2043 (car View-process-field-name-history)
2044 View-process-field-name-history)
2045 (read-string "Regexp for filtering the output in the field: "
2046 (car View-process-filter-history)
2047 View-process-filter-history)
2050 (setq buffer-read-only nil)
2051 (View-process-filter-fields-in-region
2053 (View-process-translate-field-name-to-position field-name)
2054 View-process-output-start
2055 View-process-output-end
2057 (setq buffer-read-only t)
2058 (if (not dont-remember)
2059 (setq View-process-actual-sorter-and-filter
2060 (append View-process-actual-sorter-and-filter
2061 (list (list (if exclude 'exclude-filter 'filter)
2065 (defun View-process-filter-output-by-current-field (regexp
2068 "Filter the whole output by the field under the point with REGEXP.
2069 The matching lines are deleted if EXCLUDE is t. The non matching
2070 lines are deleted if EXCLUDE is nil. If you call this function
2071 interactive, then you can give a prefix arg to set EXCLUDE to non-nil.
2072 If DONT-REMEMBER is t, then the filter command isn't inserted
2073 in the `View-process-actual-sorter-and-filter' list."
2074 ; (interactive "sRegexp for filtering the output in the current field: \nP")
2076 (let* ((View-process-stop-motion-help t)
2077 (regexp (read-string
2078 "sRegexp for filtering the output in the current field: "))
2079 (exclude current-prefix-arg))
2080 (list regexp exclude)))
2081 (let ((current-field-number (View-process-current-field-number)))
2082 (setq buffer-read-only nil)
2083 (View-process-filter-fields-in-region regexp
2084 current-field-number
2085 View-process-output-start
2086 View-process-output-end
2088 (setq buffer-read-only t)
2089 (if (not dont-remember)
2090 (setq View-process-actual-sorter-and-filter
2091 (append View-process-actual-sorter-and-filter
2093 (list (if exclude 'exclude-filter 'filter)
2094 (View-process-translate-field-position-to-name
2095 current-field-number)
2098 (defun View-process-filter-region-by-current-field (regexp &optional exclude)
2099 "Filter the region by the field under the point with REGEXP.
2100 The matching lines are deleted if EXCLUDE is t. The non matching
2101 lines are deleted if EXCLUDE is nil. If you call this function
2102 interactive, then you can give a prefix arg to set EXCLUDE to non-nil."
2103 ; (interactive "sRegexp for filtering the region in the current field: \nP")
2105 (let* ((View-process-stop-motion-help t)
2106 (regexp (read-string
2107 "sRegexp for filtering the region in the current field: "))
2108 (exclude current-prefix-arg))
2109 (list regexp exclude)))
2110 (setq buffer-read-only nil)
2111 (View-process-filter-fields-in-region
2113 (View-process-current-field-number)
2115 (goto-char (region-beginning))
2116 (View-process-return-beginning-of-line))
2118 (goto-char (region-end))
2119 (View-process-return-end-of-line))
2121 (setq buffer-read-only t))
2123 (defun View-process-filter-by-current-field-g (&optional exclude)
2124 "Filter the whole output by the field under the point with an Regexp.
2125 It is a generic interface to `View-process-filter-region-by-current-field'
2126 and `View-process-filter-output-by-current-field'. The first will be called
2127 if a region is active and the other one if not.
2128 The matching lines are deleted if EXCLUDE is t. The non matching
2129 lines are deleted if EXCLUDE is nil. If you call this function
2130 interactive, then you can give a prefix arg to set EXCLUDE to non-nil."
2132 (setq prefix-arg current-prefix-arg)
2133 (if (View-process-region-active-p)
2134 (call-interactively 'View-process-filter-region-by-current-field)
2135 (call-interactively 'View-process-filter-output-by-current-field)))
2137 (defun View-process-filter-output (regexp &optional exclude dont-remember)
2138 "Filter the whole output with REGEXP.
2139 The matching lines are deleted if EXCLUDE is t. The non matching
2140 lines are deleted if EXCLUDE is nil. If you call this function
2141 interactive, then you can give a prefix arg to set EXCLUDE to non-nil.
2142 If DONT-REMEMBER is t, then the filter command isn't inserted
2143 in the `View-process-actual-sorter-and-filter' list."
2144 ; (interactive "sRegexp for filtering the output: \nP")
2146 (let* ((View-process-stop-motion-help t)
2147 (regexp (read-string
2148 "sRegexp for filtering the output: "))
2149 (exclude current-prefix-arg))
2150 (list regexp exclude)))
2151 (setq buffer-read-only nil)
2152 (View-process-filter-fields-in-region regexp
2154 View-process-output-start
2155 View-process-output-end
2157 (setq buffer-read-only t)
2158 (if (not dont-remember)
2159 (setq View-process-actual-sorter-and-filter
2160 (append View-process-actual-sorter-and-filter
2161 (list (list (if exclude 'exclude-grep 'grep)
2164 (defun View-process-filter-region (regexp &optional exclude)
2165 "Filter the region with REGEXP.
2166 The matching lines are deleted if EXCLUDE is t. The non matching
2167 lines are deleted if EXCLUDE is nil. If you call this function
2168 interactive, then you can give a prefix arg to set EXCLUDE to non-nil."
2169 ; (interactive "sRegexp for filtering the region: \nP")
2171 (let* ((View-process-stop-motion-help t)
2172 (regexp (read-string
2173 "sRegexp for filtering the region: "))
2174 (exclude current-prefix-arg))
2175 (list regexp exclude)))
2176 (setq buffer-read-only nil)
2177 (View-process-filter-fields-in-region
2181 (goto-char (region-beginning))
2182 (View-process-return-beginning-of-line))
2184 (goto-char (region-end))
2185 (View-process-return-end-of-line))
2187 (setq buffer-read-only t))
2189 (defun View-process-filter-g (&optional exclude)
2190 "Filters the output by the field under the point with an Regexp.
2191 It is a generic interface to `View-process-filter-region'
2192 and `View-process-filter-output'. The first will be called
2193 if a region is active and the other one if not.
2194 The matching lines are deleted if EXCLUDE is t. The non matching
2195 lines are deleted if EXCLUDE is nil. If you call this function
2196 interactive, then you can give a prefix arg to set EXCLUDE to non-nil."
2198 (setq prefix-arg current-prefix-arg)
2199 (if (View-process-region-active-p)
2200 (call-interactively 'View-process-filter-region)
2201 (call-interactively 'View-process-filter-output)))
2204 ;;; call sorter, filter or grep after running ps
2206 (defun View-process-call-sorter-and-filter (sorter-and-filter-list)
2207 "Call sorter, filter or grep after running ps.
2208 The sorter, filter or grep commands and its parameters are called
2209 from SORTER-AND-FILTER-LIST."
2210 (cond ((not sorter-and-filter-list) t)
2211 ((eq 'grep (car (car sorter-and-filter-list)))
2212 (View-process-filter-output (car (cdr (car sorter-and-filter-list)))
2215 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
2216 ((eq 'exclude-grep (car (car sorter-and-filter-list)))
2217 (View-process-filter-output (car (cdr (car sorter-and-filter-list)))
2220 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
2221 ((eq 'sort (car (car sorter-and-filter-list)))
2222 (if (assoc (car (cdr (car sorter-and-filter-list)))
2223 View-process-field-names)
2224 (View-process-sort-output-by-field
2225 (car (cdr (car sorter-and-filter-list)))
2227 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
2228 ((eq 'filter (car (car sorter-and-filter-list)))
2229 (if (assoc (car (cdr (car sorter-and-filter-list)))
2230 View-process-field-names)
2231 (View-process-filter-output-by-field
2232 (car (cdr (car sorter-and-filter-list)))
2233 (car (cdr (cdr (car sorter-and-filter-list))))
2236 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
2237 ((eq 'exclude-filter (car (car sorter-and-filter-list)))
2238 (if (assoc (car (cdr (car sorter-and-filter-list)))
2239 View-process-field-names)
2240 (View-process-filter-output-by-field
2241 (car (cdr (car sorter-and-filter-list)))
2242 (car (cdr (cdr (car sorter-and-filter-list))))
2245 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
2246 ((eq 'reverse (car (car sorter-and-filter-list)))
2247 (View-process-reverse-output t)
2248 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
2249 (t (error "Filter/Sorter command not implemented!"))))
2254 (defun View-process-get-child-process-list-1 (pid pid-ppid-alist)
2255 "Internal function of `View-process-get-child-process-list'."
2256 (cond ((car pid-ppid-alist)
2257 (if (not (string= pid (cdr (car pid-ppid-alist))))
2258 (View-process-get-child-process-list-1 pid (cdr pid-ppid-alist))
2259 (cons (car (car pid-ppid-alist))
2260 (View-process-get-child-process-list-1 pid
2261 (cdr pid-ppid-alist))
2264 (defun View-process-get-child-process-list (pid pid-ppid-alist)
2265 "Return a list with all direct children of the processes with PID.
2266 The list PID-PPID-ALIST is an alist with the PIDs as cars
2268 Example list: (\"0\" \"10\" \"20\")
2269 With \"0\" eq PID as the parent of the direct children \"10\" and \"20\"."
2270 (cons pid (View-process-get-child-process-list-1 pid pid-ppid-alist)))
2272 (defun View-process-get-child-process-tree (pid)
2273 "Return a list with all children and subchildren of the processes with PID.
2274 Example list: (\"0\" (\"10\") (\"20\" (\"30\" \"40\")))
2275 With \"0\" eq PID as the parent of the direct children \"10\" and \"20\"
2276 and with \"20\" as the parent of the direct children \"30\" and \"40\"."
2278 (mapcar 'View-process-get-child-process-tree
2279 (cdr (View-process-get-child-process-list
2282 (View-process-get-pid-ppid-list-from-region
2283 View-process-output-start
2284 View-process-output-end)))))))
2286 ;(defun View-process-highlight-process-tree (process-tree)
2287 ; "Highlights all processes in the list process-tree."
2288 ; (cond ((not process-tree))
2289 ; ((listp (car process-tree))
2290 ; (View-process-highlight-process-tree (car process-tree))
2291 ; (View-process-highlight-process-tree (cdr process-tree)))
2292 ; ((stringp (car process-tree))
2293 ; (View-process-highlight-line-with-pid (car process-tree)
2294 ; 'View-process-child-line-face
2295 ; View-process-child-line-mark)
2296 ; (View-process-highlight-process-tree (cdr process-tree)))
2297 ; (t (error "Bug in 'View-process-highlight-process-tree' !"))))
2299 ;(defun View-process-highlight-recursive-all-children (pid)
2300 ; "Highlights all children of the process with the PID."
2301 ; (interactive "sParent PID: ")
2303 ; (View-process-field-name-exists-p View-process-ppid-field-name))
2304 ; (error "ERROR: No field `%s' in the output, try `M-x ps -j' to get it"
2305 ; View-process-ppid-field-name)
2306 ; (View-process-highlight-line-with-pid pid
2307 ; 'View-process-parent-line-face
2308 ; View-process-parent-line-mark)
2309 ; (View-process-highlight-process-tree
2310 ; (cdr (View-process-get-child-process-tree pid)))))
2312 ;(defun View-process-highlight-recursive-all-children-in-line ()
2313 ; "Highlights all the child processes of the process in the current line."
2315 ; (View-process-highlight-recursive-all-children
2316 ; (View-process-get-pid-from-current-line)))
2320 (defun View-process-send-signal-to-processes-with-mark (signal)
2321 "Sends a SIGNAL to all processes, which are marked."
2323 (let* ((View-process-stop-motion-help t)
2324 (signal (completing-read "Signal: "
2325 View-process-kill-signals
2328 View-process-default-kill-signal
2329 View-process-signal-history)))
2331 (if View-process-pid-mark-alist
2332 (View-process-call-function-on-pid-and-mark-list
2333 'View-process-send-signal-to-process-in-line
2334 View-process-pid-mark-alist
2337 (error "ERROR: There is no marked process!")))
2339 (defun View-process-send-signal-to-processes-in-region (signal)
2340 "Sends a SIGNAL to all processes in the current region."
2342 (let* ((View-process-stop-motion-help t)
2343 (signal (completing-read "Signal: "
2344 View-process-kill-signals
2347 View-process-default-kill-signal
2348 View-process-signal-history)))
2350 (let ((region-start (if (> (region-beginning) View-process-output-start)
2352 View-process-output-start))
2353 (region-end (if (< (region-end) View-process-output-end)
2355 View-process-output-end)))
2357 (goto-char region-start)
2359 (let ((pid-list (View-process-get-pid-list-from-region (point)
2361 (View-process-send-signal-to-processes-in-pid-list signal
2367 (defun View-process-send-signal-to-processes-in-pid-list (signal
2372 "Sends a SIGNAL to all processes with a pid in PID-LIST.
2373 If DONT-ASK is non-nil, then no confirmation question will be asked.
2374 If DONT-UPDATE is non-nil, then the command `View-process-status-update'
2375 will not be run after sending a signal."
2378 (View-process-send-signal-to-process signal
2382 (View-process-send-signal-to-processes-in-pid-list signal
2387 (defun View-process-send-signal-to-process-in-line (signal)
2388 "Sends a SIGNAL to the process in the current line."
2390 (let* ((View-process-stop-motion-help t)
2391 (signal (completing-read "Signal: "
2392 View-process-kill-signals
2395 View-process-default-kill-signal
2396 View-process-signal-history)))
2398 (if (and (>= (point) View-process-output-start)
2399 (< (point) View-process-output-end))
2400 (View-process-send-signal-to-process
2402 (View-process-get-pid-from-current-line)
2406 (defun View-process-send-key-as-signal-to-processes ()
2407 "Converts the key which invokes this command to a signal.
2408 After that it sends this signal to the process in the current line,
2409 or, if an active region exists, to all processes in the region.
2410 For this function only numbers could be used as keys."
2412 (let ((signal (View-process-return-current-command-key-as-string)))
2413 (if (not (= 0 (string-to-int signal)))
2414 (if (View-process-region-active-p)
2415 (View-process-send-signal-to-processes-in-region signal)
2416 (View-process-send-signal-to-process-in-line signal))
2417 (error "ERROR: This command must be bound to and called by a number key!")
2420 (defun View-process-send-signal-to-processes-g ()
2421 "Sends a signal to processes.
2422 It is a generic interface to `View-process-send-signal-to-processes-in-region'
2423 and `View-process-send-signal-to-process-in-line'. The first will be called
2424 if a region is active and the other one if not. If the region isn't
2425 active, but marks are set, then the function is called on every
2428 (cond ((View-process-region-active-p)
2429 (call-interactively 'View-process-send-signal-to-processes-in-region))
2430 (View-process-pid-mark-alist
2431 (call-interactively 'View-process-send-signal-to-processes-with-mark))
2433 (call-interactively 'View-process-send-signal-to-process-in-line))))
2435 (defun View-process-send-signal-to-process (signal
2440 "Sends the SIGNAL to the process with the PID.
2441 If DONT-ASK is non-nil, then no confirmation question will be asked.
2442 If DONT-UPDATE is non-nil, then the command `View-process-status-update'
2443 will not be run after sending the signal."
2445 (let* ((View-process-stop-motion-help t)
2446 (signal (completing-read "Signal: "
2447 View-process-kill-signals
2450 View-process-default-kill-signal
2451 View-process-signal-history))
2452 (pid (int-to-string (read-number "Process Id (PID): "))))
2454 (if (and (eq (string-to-int pid) (emacs-pid))
2455 (or (not View-process-remote-host)
2456 (string= View-process-remote-host (getenv "HOSTNAME"))))
2457 (error "Hey, are you a murderer? You've just tried to kill me!")
2459 ; (signal-line-extent
2460 ; (View-process-highlight-line-with-pid
2462 ; 'View-process-signal-line-face
2463 ; View-process-signal-line-mark))
2464 (signal-number (car (cdr (assoc signal View-process-kill-signals)))))
2465 (View-process-mark-line-with-pid pid View-process-signal-line-mark)
2467 (if (string= signal-number signal)
2469 "Do you really want to send signal %s to PID %s? "
2473 (format "Do you really want to send signal %s (%s) to PID %s? "
2478 (if View-process-remote-host
2479 (call-process View-process-rsh-command
2483 View-process-remote-host
2484 (concat View-process-signal-command
2489 (call-process View-process-signal-command
2493 (concat "-" signal-number)
2495 (if (not dont-update)
2496 (View-process-status-update)
2497 (View-process-mark-line-with-pid pid
2498 View-process-signaled-line-mark)
2500 ; (View-process-delete-extent signal-line-extent)
2501 (if (View-process-goto-line-with-pid pid)
2502 (View-process-unmark-current-line))
2506 ;;; renice processes
2508 (defun View-process-read-nice-value ()
2509 "Read and return a valid nice value."
2510 (let ((nice-value nil)
2511 (min-value (if (string= (user-real-login-name) "root") -20 1))
2512 (prompt "Add nice value [%d ... 20]: "))
2513 (while (not nice-value)
2514 (setq nice-value (read-string (format prompt min-value)
2515 View-process-default-nice-value))
2516 (if (and (string= (int-to-string (string-to-int nice-value))
2518 (>= (string-to-int nice-value) min-value)
2519 (<= (string-to-int nice-value) 20)
2520 (not (= (string-to-int nice-value) 0)))
2521 (if (> (string-to-int nice-value) 0)
2523 (concat "+" (int-to-string (string-to-int nice-value)))))
2524 (setq nice-value nil)
2526 "Wrong Format! Try again. Add nice value [%d ... 20]: ")))
2529 (defun View-process-renice-process (nice-value
2534 "Alter priority of the process with the PID.
2535 NICE-VALUE is the value, which will be added to the old nice value.
2536 If DONT-ASK is non-nil, then no confirmation question will be asked.
2537 If DONT-UPDATE is non-nil, then the command `View-process-status-update'
2538 will not be run after renicing."
2540 (let* ((View-process-stop-motion-help t)
2541 (nice-value (View-process-read-nice-value))
2542 (pid (int-to-string (read-number "Process Id (PID): "))))
2543 (list nice-value pid)))
2544 ; (let ((signal-line-extent
2545 ; (View-process-highlight-line-with-pid
2547 ; 'View-process-signal-line-face
2548 ; View-process-renice-line-mark)))
2549 (View-process-mark-line-with-pid pid View-process-renice-line-mark)
2552 "Do you really want to renice PID %s with %s? "
2556 (if View-process-remote-host
2557 (call-process View-process-rsh-command
2561 View-process-remote-host
2562 (concat View-process-renice-command
2567 (call-process View-process-renice-command
2573 (if (not dont-update)
2574 (View-process-status-update)
2575 (View-process-mark-line-with-pid pid View-process-signaled-line-mark)
2577 ; (View-process-delete-extent signal-line-extent)
2578 (if (View-process-goto-line-with-pid pid)
2579 (View-process-unmark-current-line))))
2581 (defun View-process-renice-processes-with-mark (nice-value)
2582 "Alter priority of all processes, which are marked.
2583 NICE-VALUE is the value, which will be added to the old nice value."
2585 (let* ((View-process-stop-motion-help t)
2586 (nice-value (View-process-read-nice-value)))
2588 (if View-process-pid-mark-alist
2589 (View-process-call-function-on-pid-and-mark-list
2590 'View-process-renice-process-in-line
2591 View-process-pid-mark-alist
2594 (error "ERROR: There is no marked process!")))
2596 (defun View-process-renice-processes-in-region (nice-value)
2597 "Alter priority of all processes in the current region.
2598 NICE-VALUE is the value, which will be added to the old nice value."
2600 (let* ((View-process-stop-motion-help t)
2601 (nice-value (View-process-read-nice-value)))
2603 (let ((region-start (if (> (region-beginning) View-process-output-start)
2605 View-process-output-start))
2606 (region-end (if (< (region-end) View-process-output-end)
2608 View-process-output-end)))
2610 (goto-char region-start)
2612 (let ((pid-list (View-process-get-pid-list-from-region (point)
2614 (View-process-renice-processes-in-pid-list nice-value pid-list nil t)
2617 (defun View-process-renice-processes-in-pid-list (nice-value
2622 "Alter priority all processes with a pid in PID-LIST.
2623 NICE-VALUE is the value, which will be added to the old nice value.
2624 If DONT-ASK is non-nil, then no confirmation question will be asked.
2625 If DONT-UPDATE is non-nil, then the command `View-process-status-update'
2626 will not be run after renicing"
2629 (View-process-renice-process nice-value
2633 (View-process-renice-processes-in-pid-list nice-value
2638 (defun View-process-renice-process-in-line (nice-value)
2639 "Alter priority of to the process in the current line.
2640 NICE-VALUE is the value, which will be added to the old nice value."
2642 (let* ((View-process-stop-motion-help t)
2643 (nice-value (View-process-read-nice-value)))
2645 (if (and (>= (point) View-process-output-start)
2646 (< (point) View-process-output-end))
2647 (View-process-renice-process
2649 (View-process-get-pid-from-current-line)
2653 (defun View-process-renice-processes-g ()
2654 "Alter priority of processes.
2655 It is a generic interface to `View-process-renice-processes-in-region'
2656 and `View-process-renice-process-in-line'. The first will be called
2657 if a region is active and the other one if not. If the region isn't
2658 active, but marks are set, then the function is called on every
2661 (cond ((View-process-region-active-p)
2662 (call-interactively 'View-process-renice-processes-in-region))
2663 (View-process-pid-mark-alist
2664 (call-interactively 'View-process-renice-processes-with-mark))
2666 (call-interactively 'View-process-renice-process-in-line))))
2669 ;;; Returning field values
2671 (defun View-process-get-pid-from-current-line ()
2672 "Return a string with the pid of the process in the current line."
2673 (View-process-get-field-value-from-current-line
2674 (View-process-translate-field-name-to-position View-process-pid-field-name)
2675 View-process-max-fields)
2678 (defun View-process-get-ppid-from-current-line ()
2679 "Return a string with the ppid of the process in the current line."
2680 (View-process-get-field-value-from-current-line
2681 (View-process-translate-field-name-to-position View-process-ppid-field-name)
2682 View-process-max-fields)
2685 (defun View-process-get-pid-list-from-region (begin end)
2686 "Return a list with all PIDs in the region from BEGIN to END."
2688 (if (>= (point) end)
2690 (cons (View-process-get-pid-from-current-line)
2691 (progn (forward-line)
2692 (View-process-get-pid-list-from-region (point) end)))))
2694 (defun View-process-get-pid-ppid-list-from-region (begin end)
2695 "Return a list with all PIDs and their PPIDs in the region
2696 from BEGIN to END. END must be greater than BEGIN."
2698 (if (>= (point) end)
2700 (cons (cons (View-process-get-pid-from-current-line)
2701 (View-process-get-ppid-from-current-line))
2702 (progn (forward-line)
2703 (View-process-get-pid-ppid-list-from-region (point) end)))))
2705 (defun View-process-get-field-value-from-current-line (field-no max-fields)
2706 "Return the value of the field FIELD-NO from the current line as string.
2707 If FIELD-NO is >= MAX-FIELDS, then the rest of the line after the
2708 start of the field FIELD-NO will be returned."
2710 (View-process-jump-to-field field-no max-fields)
2711 (if (>= field-no max-fields)
2712 (buffer-substring (point) (View-process-return-end-of-line))
2716 (defun View-process-jump-to-field (field-no max-fields)
2717 "Set the point at the start of field FIELD-NO in the current line.
2718 MAX-FIELDS is used instead of FIELD-NO if FIELD-NO > MAX-FIELDS."
2719 (View-process-replaces-blanks-in-fields-if-necessary)
2721 (skip-chars-forward " ")
2723 (error "Parameter FIELD-NO must be >= 1"))
2724 (if (> field-no max-fields)
2725 (setq field-no max-fields))
2728 (skip-chars-forward "^ ")
2729 (skip-chars-forward " ")
2730 (View-process-jump-to-field-1 (1- field-no))))
2732 (defun View-process-jump-to-field-1 (field-no)
2733 "Internal function of `View-process-jump-to-field'."
2736 (skip-chars-forward "^ ")
2737 (skip-chars-forward " ")
2738 (View-process-jump-to-field-1 (1- field-no))))
2741 (defun View-process-display-emacs-pid ()
2742 "Set the point to the line with the emacs process."
2744 (message (format "This emacs has the PID `%d'!" (emacs-pid))))
2749 (defun View-process-mouse-kill (event)
2750 "Function for kill a process with the mouse."
2752 (mouse-set-point event)
2753 (View-process-send-signal-to-process-in-line "SIGTERM"))
2756 ;;; Highlighting functions
2758 (defun View-process-highlight-current-line (face)
2759 "Highlight the current line with the FACE."
2760 (let ((read-only buffer-read-only))
2761 (setq buffer-read-only nil)
2762 (let ((extent (make-extent (View-process-return-beginning-of-line)
2763 (View-process-return-end-of-line))))
2764 (set-extent-face extent face)
2765 (setq buffer-read-only read-only)
2769 (defun View-process-goto-line-with-pid (pid)
2770 "Set the point in the line with the PID.
2771 It returns nil if there is no line with the PID in the output."
2772 (if (string= pid (View-process-get-pid-from-current-line))
2774 (goto-char View-process-output-start)
2775 (while (and (< (point) View-process-output-end)
2776 (not (string= pid (View-process-get-pid-from-current-line))))
2778 (< (point) View-process-output-end)))
2780 ;(defun View-process-highlight-line-with-pid (pid face mark)
2781 ; "Highlights the line with the PID with the FACE and sets the MARK.
2782 ;It returns the extent of the line."
2784 ; (View-process-goto-line-with-pid pid)
2785 ; (View-process-set-mark-in-current-line mark)
2786 ; (View-process-save-pid-and-mark pid mark)
2787 ; (View-process-highlight-current-line face)
2790 ;(defun View-process-delete-extent (extent)
2791 ; "Deletes the extent EXTENT."
2792 ; (let ((read-only buffer-read-only))
2794 ; (goto-char (extent-start-position extent))
2795 ; (View-process-set-mark-in-current-line View-process-no-mark)
2796 ; (setq buffer-read-only nil)
2797 ; (delete-extent extent)
2798 ; (setq buffer-read-only read-only))))
2802 (defun View-process-save-pid-and-mark (pid mark)
2803 "Save the PID and the MARK in a special alist.
2804 The name of the alist is `View-process-pid-mark-alist'."
2805 (if (assoc pid View-process-pid-mark-alist)
2806 (setcdr (assoc pid View-process-pid-mark-alist) (list mark ))
2807 (setq View-process-pid-mark-alist
2808 (cons (list pid mark) View-process-pid-mark-alist))))
2810 (defun View-process-remove-pid-and-mark-1 (pid pid-mark-alist)
2811 "Internal function of `View-process-remove-pid-and-mark'."
2812 (cond ((not pid-mark-alist)
2814 ((string= pid (car (car pid-mark-alist)))
2815 (View-process-remove-pid-and-mark-1 pid (cdr pid-mark-alist)))
2817 (cons (car pid-mark-alist)
2818 (View-process-remove-pid-and-mark-1 pid (cdr pid-mark-alist)))
2821 (defun View-process-remove-pid-and-mark (pid)
2822 "Remove the PID from the alist `View-process-pid-mark-alist'."
2823 (setq View-process-pid-mark-alist
2824 (View-process-remove-pid-and-mark-1 pid View-process-pid-mark-alist))
2827 (defun View-process-set-mark-in-current-line (mark)
2828 "Set the MARK at the start of the current line."
2829 (let ((buffer-read-only nil))
2835 (defun View-process-mark-line-with-pid (pid &optional mark)
2836 "Set the MARK in the line with the PID.
2837 Uses 'View-process-single-line-mark' if mark is nil."
2838 ; (interactive "sPID: ")
2839 (interactive (let ((View-process-stop-motion-help t))
2840 (list (read-string "PID: "))))
2842 (View-process-goto-line-with-pid pid)
2843 (View-process-set-mark-in-current-line (or mark
2844 View-process-single-line-mark))
2845 (View-process-save-pid-and-mark pid
2847 View-process-single-line-mark))
2850 (defun View-process-mark-current-line (&optional mark)
2851 "Set a mark in the current line.
2852 It uses the 'View-process-single-line-mark' if MARK is nil."
2854 (if (or (< (point) View-process-output-start)
2855 (> (point) View-process-output-end))
2856 (error "ERROR: Not in a process line!")
2857 (View-process-set-mark-in-current-line (or mark
2858 View-process-single-line-mark))
2859 (View-process-save-pid-and-mark (View-process-get-pid-from-current-line)
2861 View-process-single-line-mark))))
2864 (defun View-process-unmark-current-line ()
2865 "Unsets a mark in the current line."
2867 (if (and (>= (point) View-process-output-start)
2868 (<= (point) View-process-output-end))
2870 (View-process-remove-pid-and-mark
2871 (View-process-get-pid-from-current-line))
2872 (View-process-set-mark-in-current-line View-process-no-mark)
2874 (error "ERROR: Not in a process line!")))
2876 (defun View-process-mark-process-tree (process-tree)
2877 "Marks all processes in the list process-tree."
2878 (cond ((not process-tree))
2879 ((listp (car process-tree))
2880 (View-process-mark-process-tree (car process-tree))
2881 (View-process-mark-process-tree (cdr process-tree)))
2882 ((stringp (car process-tree))
2883 (View-process-mark-line-with-pid (car process-tree)
2884 View-process-child-line-mark)
2885 (View-process-mark-process-tree (cdr process-tree)))
2886 (t (error "Bug in 'View-process-mark-process-tree' !"))))
2888 (defun View-process-mark-children (pid)
2889 "Mark all children of the process with the PID."
2890 ; (interactive "sParent PID: ")
2891 (interactive (let ((View-process-stop-motion-help t))
2892 (list (read-string "Parent PID: "))))
2894 (View-process-field-name-exists-p View-process-ppid-field-name))
2895 (error "ERROR: No field `%s' in the output, try `M-x ps -j' to get it"
2896 View-process-ppid-field-name)
2897 (View-process-mark-line-with-pid pid View-process-parent-line-mark)
2898 (View-process-mark-process-tree
2899 (cdr (View-process-get-child-process-tree pid)))))
2901 (defun View-process-mark-children-in-current-line ()
2902 "Mark all the child processes of the process in the current line."
2904 (View-process-mark-children
2905 (View-process-get-pid-from-current-line)))
2907 (defun View-process-call-function-on-pid-and-mark-list (function
2912 non-interactive-args)
2913 "Call FUNCTION on every process in the PID-MARK-ALIST.
2914 FUNCTION must be an interactive function, which works on the
2915 process in the current line, if NOT-INTERACTIVE is nil.
2916 If NOT-INTERACTIVE is t, then the function will be called non interactively
2917 with NON-INTERACTIVE-ARGS."
2918 (cond ((not pid-mark-alist))
2919 ((View-process-goto-line-with-pid (car (car pid-mark-alist)))
2921 (eval (cons function non-interactive-args))
2922 (call-interactively function))
2923 (eval (append (list 'View-process-call-function-on-pid-and-mark-list
2925 '(cdr pid-mark-alist)
2927 non-interactive-args)))
2929 (eval (append (list 'View-process-call-function-on-pid-and-mark-list
2931 '(cdr pid-mark-alist)
2933 non-interactive-args)))
2936 (defun View-process-set-marks-from-pid-mark-alist (pid-mark-alist)
2937 "Set the marks of the PID-MARK-ALIST to the pids of the PID-MARK-ALIST."
2938 (cond ((not pid-mark-alist))
2939 ((View-process-goto-line-with-pid (car (car pid-mark-alist)))
2940 (View-process-mark-current-line (car (cdr (car pid-mark-alist))))
2941 (View-process-set-marks-from-pid-mark-alist (cdr pid-mark-alist)))
2943 (View-process-set-marks-from-pid-mark-alist (cdr pid-mark-alist)))))
2945 (defun View-process-reset-last-marks ()
2946 "Reset the last marks."
2948 (View-process-set-marks-from-pid-mark-alist View-process-last-pid-mark-alist)
2951 (defun View-process-unmark-all ()
2952 "Unmark all processes."
2954 (View-process-call-function-on-pid-and-mark-list
2955 'View-process-unmark-current-line
2956 View-process-pid-mark-alist
2960 ;;; commands to moving around in a ps buffer
2962 (defun View-process-output-start ()
2963 "Set point to the first field after the output start."
2965 (goto-char View-process-output-start)
2966 (skip-chars-forward " "))
2968 (defun View-process-output-end ()
2969 "Set point to the first field before the output end."
2971 (goto-char View-process-output-end)
2972 (skip-chars-backward " ")
2973 (skip-chars-backward "^ "))
2975 (defun View-process-next-field ()
2976 "Moves forward one field."
2978 (if (< (point) View-process-output-start)
2979 (View-process-output-start)
2980 (skip-chars-forward " ")
2981 (if (< (point) View-process-output-end)
2982 (if (= View-process-max-fields (View-process-current-field-number))
2985 (skip-chars-forward " ")
2986 (if (>= (point) View-process-output-end)
2988 (goto-char View-process-output-start)
2989 (skip-chars-forward " "))))
2990 (skip-chars-forward "^ ")
2991 (skip-chars-forward " ")
2993 (goto-char View-process-output-start)
2994 (skip-chars-forward " "))))
2996 (defun View-process-previous-field ()
2997 "Moves backward one field."
2999 (skip-chars-backward " ")
3001 (if (> (point) View-process-output-start)
3002 (if (= View-process-max-fields (View-process-current-field-number))
3003 (View-process-jump-to-field View-process-max-fields
3004 View-process-max-fields)
3005 (skip-chars-backward "^ \n")
3006 (if (< (point) View-process-output-start)
3008 (goto-char View-process-output-end)
3010 (View-process-jump-to-field View-process-max-fields
3011 View-process-max-fields))))
3012 (goto-char View-process-output-end)
3014 (View-process-jump-to-field View-process-max-fields
3015 View-process-max-fields)))
3017 (defun View-process-goto-first-field-next-line ()
3018 "Set point to the first field in the next line."
3020 (if (< (point) View-process-output-start)
3021 (View-process-output-start)
3023 (if (>= (point) View-process-output-end)
3024 (View-process-output-start)
3025 (View-process-jump-to-field 1 View-process-max-fields))))
3030 (defun View-process-rename-current-output-buffer (new-buffer-name)
3031 "Renames the ps output buffer to NEW-BUFFER-NAME."
3033 (let ((View-process-stop-motion-help t))
3035 (read-string "New PS output buffer name: "
3036 (generate-new-buffer-name
3038 (or View-process-remote-host
3039 (getenv "HOSTNAME"))
3041 (if (not (string= mode-name View-process-mode-name))
3042 (error "ERROR: Not in a View-process-mode buffer!")
3043 (if (get-buffer new-buffer-name)
3044 (error "ERROR: Buffer %s exists!" new-buffer-name)
3045 (rename-buffer new-buffer-name)
3046 (setq View-process-buffer-name new-buffer-name)
3047 (if (or View-process-display-with-2-windows
3048 (get-buffer View-process-header-buffer-name))
3049 (let ((new-header-buffer-name
3050 (generate-new-buffer-name
3051 (concat (substring new-buffer-name 0 -1)
3053 (buffer (current-buffer)))
3054 (set-buffer View-process-header-buffer-name)
3055 (rename-buffer new-header-buffer-name)
3057 (setq View-process-header-buffer-name new-header-buffer-name))
3060 ;;; For newer versions of field.el
3061 (if (not (fboundp 'sort-float-fields))
3062 (defalias 'sort-float-fields 'sort-numeric-fields))
3065 ;;; Display Functions
3067 (defun View-process-header-mode ()
3068 "The mode of the buffer with the view process header."
3069 (set-syntax-table View-process-mode-syntax-table)
3070 (setq major-mode 'View-process-header-mode
3071 mode-name View-process-header-mode-name)
3072 (setq truncate-lines View-process-truncate-lines)
3073 ; (setq buffer-modeline (not View-process-header-mode-line-off))
3074 (view-process-switch-buffer-modeline (not View-process-header-mode-line-off))
3075 (run-hooks 'View-process-header-mode-hook)
3078 (defun View-process-top-window-p (&optional window)
3079 "Return t if the WINDOW is the top one.
3080 If WINDOW is nil, then the current window is tested."
3081 (eq 0 (car (cdr (window-pixel-edges window)))))
3083 (defun View-process-change-display-type (display-with-2-windows)
3084 "If DISPLAY-WITH-2-WINDOWS is non-nil, then a 2 windows display is used."
3085 (if display-with-2-windows
3086 (let ((window-size View-process-ps-header-window-size))
3087 (cond ((eq (count-windows 'NO-MINI) 1)
3089 (split-window nil window-size)
3090 (select-window (next-window nil 'no-minibuf))
3092 ((= (count-windows 'NO-MINI) 2)
3093 (if (View-process-top-window-p)
3095 ;; delete other windows
3096 (delete-other-windows)
3098 (split-window nil window-size))
3099 (select-window (next-window nil 'no-minibuf))
3100 ; (shrink-window (- (window-height) window-size))
3102 (select-window (next-window nil 'no-minibuf))
3104 ((> (count-windows 'NO-MINI) 2)
3105 ;; delete other windows
3106 (delete-other-windows)
3108 (split-window nil window-size)
3109 (select-window (next-window nil 'no-minibuf))
3111 ;; copy header lines
3112 (let ((header-lines (buffer-substring (point-min)
3113 View-process-header-end))
3114 (buffer (get-buffer-create View-process-header-buffer-name)))
3115 (select-window (next-window nil 'no-minibuf))
3116 ;; load *ps-header* buffer in window
3117 (set-window-buffer (get-buffer-window (current-buffer)) buffer)
3118 (setq buffer-read-only nil)
3120 ;; insert header lines
3121 (insert header-lines)
3122 (setq buffer-read-only t)
3123 (goto-char (point-min))
3124 (View-process-header-mode)
3125 (if (not (= (window-height) window-size))
3126 (shrink-window (- (window-height) window-size)))
3127 (select-window (next-window nil 'no-minibuf))
3129 (let ((header-buffer (get-buffer View-process-header-buffer-name)))
3132 (if (get-buffer-window header-buffer)
3133 (delete-window (get-buffer-window header-buffer)))
3134 (kill-buffer header-buffer))))))
3136 (defun View-process-toggle-display-with-2-windows (&optional arg)
3137 "Change whether the view process output is displayed with two windows.
3138 With ARG, set `View-process-display-with-2-windows' to t if ARG is
3139 positive. ARG is a prefix arg."
3142 (if (>= (prefix-numeric-value arg) 0)
3143 (setq View-process-display-with-2-windows t)
3144 (setq View-process-display-with-2-windows nil))
3145 (if View-process-display-with-2-windows
3146 (setq View-process-display-with-2-windows nil)
3147 (setq View-process-display-with-2-windows t)))
3148 (View-process-change-display-type View-process-display-with-2-windows)
3149 (if View-process-display-with-2-windows
3150 (View-process-toggle-hide-header '(1))
3151 (View-process-toggle-hide-header '(-1))))
3153 (defun View-process-save-old-window-configuration ()
3154 "Save the window configuration before the first call of view process."
3155 (if (not View-process-old-window-configuration)
3156 (setq View-process-old-window-configuration
3157 (current-window-configuration))
3160 (defun View-process-hide-header (hide-header)
3161 "Hides the header lines in the view processes buffer if HIDE-HEADER is t."
3163 (if (<= View-process-output-start (point-max))
3164 (narrow-to-region View-process-output-start (point-max))
3165 (narrow-to-region (point-max) (point-max)))
3168 (defun View-process-toggle-hide-header (&optional arg)
3169 "Change whether the header are hided.
3170 With ARG, set `View-process-hide-header' to t if ARG is positive.
3171 ARG is a prefix arg."
3174 (if (>= (prefix-numeric-value arg) 0)
3175 (setq View-process-hide-header t)
3176 (setq View-process-hide-header nil))
3177 (if View-process-hide-header
3178 (setq View-process-hide-header nil)
3179 (setq View-process-hide-header t)))
3180 (View-process-hide-header View-process-hide-header))
3184 (defun View-process-quit ()
3185 "Kill the *ps* buffer."
3188 "Do you want really want to quit the view process mode? ")
3190 (if (get-buffer View-process-buffer-name)
3191 (kill-buffer View-process-buffer-name))
3192 (if (or View-process-display-with-2-windows
3193 (get-buffer View-process-header-buffer-name))
3194 (kill-buffer View-process-header-buffer-name))
3195 (set-window-configuration View-process-old-window-configuration)
3196 (setq View-process-old-window-configuration nil)
3199 (defun View-process-submit-bug-report ()
3200 "Submit via mail a bug report on View-process-mode."
3203 (let ((bsd-or-system-v (View-process-bsd-or-system-v)))
3204 (reporter-submit-bug-report
3205 View-process-package-maintainer
3206 (concat View-process-package-name " " View-process-package-version)
3207 (list 'emacs-version
3209 'View-process-buffer-name
3210 'View-process-header-buffer-name
3211 'View-process-sorter-and-filter
3212 'View-process-actual-sorter-and-filter
3213 'View-process-display-with-2-windows
3214 'View-process-hide-header
3215 'View-process-truncate-lines
3216 'View-process-motion-help
3217 'View-process-old-window-configuration
3218 'View-process-field-names
3219 'View-process-max-fields
3220 'View-process-output-start
3221 'View-process-output-end
3222 'View-process-header-start
3223 'View-process-header-end
3224 'View-process-host-names-and-system-types
3225 'View-process-remote-host
3226 'View-process-system-type
3228 'View-process-rsh-command
3229 'View-process-signal-command
3230 'View-process-status-command-switches-bsd
3231 'View-process-status-command-switches-system-v
3232 'View-process-status-last-command-switches
3233 'View-process-status-command
3234 'View-process-test-command
3235 'View-process-test-switches
3236 'View-process-uname-command
3237 'View-process-uname-switches
3242 "If it is possible, you should send this bug report from the buffer\n"
3243 "with the view process mode. Please answer the following questions.\n"
3244 "Which is the name of your system? \n"
3245 "Is your system a BSD Unix? \n"
3246 "Is your system a System V Unix? \n"
3247 "Describe your bug: "
3250 (defun View-process-display-version ()
3251 "Displays the current version of the mode."
3253 (message "View Process Mode, %s, Author: Heiko Münkel."
3254 View-process-package-version))
3256 (defun View-process-toggle-truncate-lines (&optional arg)
3257 "Change whether the lines in this buffer are truncated.
3258 With ARG, set `truncate-lines' to t if ARG is positive.
3259 ARG is a prefix arg.
3260 It saves also the state of `truncate-lines' for the next
3261 view process command in `View-process-truncate-lines'.
3262 It truncates also the lines in the view process header buffer,
3263 if it is run in a view process mode buffer."
3266 (if (>= (prefix-numeric-value arg) 0)
3267 (setq truncate-lines t)
3268 (setq truncate-lines nil))
3270 (setq truncate-lines nil)
3271 (setq truncate-lines t)))
3272 (setq View-process-truncate-lines truncate-lines)
3273 (setq-default View-process-truncate-lines truncate-lines)
3274 (if (and (eq major-mode 'View-process-mode)
3275 (or View-process-display-with-2-windows
3276 (get-buffer View-process-header-buffer-name)))
3277 (let ((buffer (current-buffer))
3278 (truncate truncate-lines))
3279 (set-buffer View-process-header-buffer-name)
3280 (setq truncate-lines truncate)
3281 (set-buffer buffer))))
3283 (defun View-process-return-beginning-of-line ()
3284 "Return the beginning of the current line.
3285 The point isn't changed."
3290 (defun View-process-return-end-of-line ()
3291 "Return the end of the current line.
3292 The point isn't changed."
3297 (defun View-process-assoc-2th (key list)
3298 "Return non-nil if KEY is `equal' to the 2th of an element of LIST.
3299 The value is actually the element of LIST whose 2th is KEY."
3300 (cond ((not list) nil)
3301 ((equal (car (cdr (car list))) key) (car list))
3302 (t (View-process-assoc-2th key (cdr list)))))
3305 (defun View-process-replace-in-string (from-string
3309 "Replace FROM-STRING with TO-STRING in IN-STRING.
3310 The optional argument START set the start position > 0.
3311 FROM-STRING is a regular expression."
3312 (setq start (or start 0))
3313 (let ((start-of-from-string (string-match from-string in-string start)))
3314 (if start-of-from-string
3315 (concat (substring in-string start start-of-from-string)
3317 (View-process-replace-in-string from-string
3321 (substring in-string start))))
3324 (defun View-process-toggle-digit-bindings (&optional arg)
3325 "Change whether the digit keys sends signals to the processes.
3326 With ARG, set `View-process-digit-bindings-send-signal' to t,
3327 if ARG is positive. ARG is a prefix arg."
3330 (if (>= (prefix-numeric-value arg) 0)
3331 (setq View-process-digit-bindings-send-signal t)
3332 (setq View-process-digit-bindings-send-signal nil))
3333 (if View-process-digit-bindings-send-signal
3334 (setq View-process-digit-bindings-send-signal nil)
3335 (setq View-process-digit-bindings-send-signal t)))
3336 (if View-process-digit-bindings-send-signal
3338 (define-key View-process-mode-map "0"
3340 (define-key View-process-mode-map "1"
3341 'View-process-send-key-as-signal-to-processes)
3342 (define-key View-process-mode-map "2"
3343 'View-process-send-key-as-signal-to-processes)
3344 (define-key View-process-mode-map "3"
3345 'View-process-send-key-as-signal-to-processes)
3346 (define-key View-process-mode-map "4"
3347 'View-process-send-key-as-signal-to-processes)
3348 (define-key View-process-mode-map "5"
3349 'View-process-send-key-as-signal-to-processes)
3350 (define-key View-process-mode-map "6"
3351 'View-process-send-key-as-signal-to-processes)
3352 (define-key View-process-mode-map "7"
3353 'View-process-send-key-as-signal-to-processes)
3354 (define-key View-process-mode-map "8"
3355 'View-process-send-key-as-signal-to-processes)
3356 (define-key View-process-mode-map "9"
3357 'View-process-send-key-as-signal-to-processes)
3359 (define-key View-process-mode-map "0"
3361 (define-key View-process-mode-map "1"
3363 (define-key View-process-mode-map "2"
3365 (define-key View-process-mode-map "3"
3367 (define-key View-process-mode-map "4"
3369 (define-key View-process-mode-map "5"
3371 (define-key View-process-mode-map "6"
3373 (define-key View-process-mode-map "7"
3375 (define-key View-process-mode-map "8"
3377 (define-key View-process-mode-map "9"
3381 (if View-process-digit-bindings-send-signal
3382 (View-process-toggle-digit-bindings 1)
3383 (View-process-toggle-digit-bindings -1))
3385 (defun View-process-revert-buffer (&optional ignore-auto noconfirm)
3386 "Updates the view-process buffer with `View-process-status-update'."
3387 (View-process-status-update))
3390 ;;; Emacs version specific stuff
3392 (if (View-process-xemacs-p)
3393 (require 'view-process-xemacs)
3394 (require 'view-process-emacs-19))
3399 (if (facep 'View-process-child-line-face)
3401 (make-face 'View-process-child-line-face)
3402 (if (View-process-search-color View-process-child-line-foreground)
3403 (set-face-foreground 'View-process-child-line-face
3404 (View-process-search-color
3405 View-process-child-line-foreground)))
3406 (if (View-process-search-color View-process-child-line-background)
3407 (set-face-background 'View-process-child-line-face
3408 (View-process-search-color
3409 View-process-child-line-background)))
3410 (set-face-font 'View-process-child-line-face
3411 View-process-child-line-font)
3412 (set-face-underline-p 'View-process-child-line-face
3413 View-process-child-line-underline-p))
3415 (if (facep 'View-process-parent-line-face)
3417 (make-face 'View-process-parent-line-face)
3418 (if (View-process-search-color View-process-parent-line-foreground)
3419 (set-face-foreground 'View-process-parent-line-face
3420 (View-process-search-color
3421 View-process-parent-line-foreground)))
3422 (if (View-process-search-color View-process-parent-line-background)
3423 (set-face-background 'View-process-parent-line-face
3424 (View-process-search-color
3425 View-process-parent-line-background)))
3426 (set-face-font 'View-process-parent-line-face
3427 View-process-parent-line-font)
3428 (set-face-underline-p 'View-process-parent-line-face
3429 View-process-parent-line-underline-p))
3431 (if (facep 'View-process-single-line-face)
3433 (make-face 'View-process-single-line-face)
3434 (if (View-process-search-color View-process-single-line-foreground)
3435 (set-face-foreground 'View-process-single-line-face
3436 (View-process-search-color
3437 View-process-single-line-foreground)))
3438 (if (View-process-search-color View-process-single-line-background)
3439 (set-face-background 'View-process-single-line-face
3440 (View-process-search-color
3441 View-process-single-line-background)))
3442 (set-face-font 'View-process-single-line-face
3443 View-process-single-line-font)
3444 (set-face-underline-p 'View-process-single-line-face
3445 View-process-single-line-underline-p))
3447 (if (facep 'View-process-signaled-line-face)
3449 (make-face 'View-process-signaled-line-face)
3450 (if (View-process-search-color View-process-signaled-line-foreground)
3451 (set-face-foreground 'View-process-signaled-line-face
3452 (View-process-search-color
3453 View-process-signaled-line-foreground)))
3454 (if (View-process-search-color View-process-signaled-line-background)
3455 (set-face-background 'View-process-signaled-line-face
3456 (View-process-search-color
3457 View-process-signaled-line-background)))
3458 (set-face-font 'View-process-signaled-line-face
3459 View-process-signaled-line-font)
3460 (set-face-underline-p 'View-process-signaled-line-face
3461 View-process-signaled-line-underline-p))
3463 (if (facep 'View-process-signal-line-face)
3465 (make-face 'View-process-signal-line-face)
3466 (if (View-process-search-color View-process-signal-line-foreground)
3467 (set-face-foreground 'View-process-signal-line-face
3468 (View-process-search-color
3469 View-process-signal-line-foreground)))
3470 (if (View-process-search-color View-process-signal-line-background)
3471 (set-face-background 'View-process-signal-line-face
3472 (View-process-search-color
3473 View-process-signal-line-background)))
3474 (set-face-font 'View-process-signal-line-face
3475 View-process-signal-line-font)
3476 (set-face-underline-p 'View-process-signal-line-face
3477 View-process-signal-line-underline-p))
3479 (if (facep 'View-process-renice-line-face)
3481 (make-face 'View-process-renice-line-face)
3482 (if (View-process-search-color View-process-renice-line-foreground)
3483 (set-face-foreground 'View-process-renice-line-face
3484 (View-process-search-color
3485 View-process-renice-line-foreground)))
3486 (if (View-process-search-color View-process-renice-line-background)
3487 (set-face-background 'View-process-renice-line-face
3488 (View-process-search-color
3489 View-process-renice-line-background)))
3490 (set-face-font 'View-process-renice-line-face
3491 View-process-renice-line-font)
3492 (set-face-underline-p 'View-process-renice-line-face
3493 View-process-renice-line-underline-p))
3495 (if (facep 'View-process-header-line-face)
3497 (make-face 'View-process-header-line-face)
3498 (if (View-process-search-color View-process-header-line-foreground)
3499 (set-face-foreground 'View-process-header-line-face
3500 (View-process-search-color
3501 View-process-header-line-foreground)))
3502 (if (View-process-search-color View-process-header-line-background)
3503 (set-face-background 'View-process-header-line-face
3504 (View-process-search-color
3505 View-process-header-line-background)))
3506 (set-face-font 'View-process-header-line-face
3507 View-process-header-line-font)
3508 (set-face-underline-p 'View-process-header-line-face
3509 View-process-header-line-underline-p))
3511 (defun View-process-highlight-header-line ()
3512 "Highlight the header line with the face `View-process-header-line-face'."
3514 (make-extent View-process-header-start View-process-header-end)
3516 (set-extent-face extent 'View-process-header-line-face)
3517 (set-extent-property extent 'duplicable t))
3520 ;;; A short cut for the View-process-status command
3523 (defalias 'ps 'View-process-status)
3525 ;;; view-process-mode.el ends here