|
165
|
1 ;;; view-process-mode.el --- Display current running processes
|
|
|
2
|
|
|
3 ;; Copyright (C) 1994, 1995, 1996 Heiko Muenkel
|
|
|
4
|
|
|
5 ;; Author: Heiko Muenkel <muenkel@tnt.uni-hannover.de>
|
|
|
6 ;; Keywords: processes
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
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.
|
|
|
14
|
|
|
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.
|
|
|
19
|
|
|
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
|
|
|
23 ;; 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: Emacs 20.1
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; DollarId: view-process-mode.el,v 1.113 1996/08/17 15:12:01 muenkel 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
|
|
|
33 ;; processes.
|
|
|
34
|
|
|
35 ;; You can display the processes with the command `view-processes'.
|
|
|
36 ;; If you are familar with the UNIX ps command and its switches,
|
|
|
37 ;; then you can also use the command `View-process-status' or
|
|
|
38 ;; it's 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.
|
|
|
42
|
|
|
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
|
|
|
47 ;;
|
|
|
48 ;; Installation:
|
|
|
49 ;;
|
|
|
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."
|
|
|
59 ;; t)
|
|
|
60 ;;
|
|
|
61 ;; In the FSF Emacs 19 you should (but must not) put the following
|
|
|
62 ;; line in your ~/.emacs:
|
|
|
63 ;;; (transient-mark-mode nil)
|
|
|
64
|
|
|
65 ;;; Code:
|
|
|
66
|
|
|
67 (provide 'view-process-mode)
|
|
|
68 (require 'view-process-system-specific)
|
|
|
69
|
|
|
70 (defconst View-process-package-version "2.4")
|
|
|
71
|
|
|
72 (defconst View-process-package-name "hm--view-process")
|
|
|
73
|
|
|
74 (defconst View-process-package-maintainer "muenkel@tnt.uni-hannover.de")
|
|
|
75
|
|
|
76 (defun View-process-xemacs-p ()
|
|
|
77 "Returns non nil if the editor is the XEmacs or lemacs."
|
|
|
78 (or (string-match "Lucid" emacs-version)
|
|
|
79 (string-match "XEmacs" emacs-version)))
|
|
|
80
|
|
|
81 (defun View-process-lemacs-p ()
|
|
|
82 "Returns non nil if the editor is the lemacs."
|
|
|
83 (string-match "Lucid" emacs-version))
|
|
|
84
|
|
|
85 (if (not (View-process-xemacs-p))
|
|
|
86 (require 'view-process-adapt)
|
|
|
87 )
|
|
|
88
|
|
|
89 (defvar View-process-status-command "ps"
|
|
|
90 "*Command which reports process status (ps).
|
|
|
91 The variable is buffer local.")
|
|
|
92
|
|
|
93 (make-variable-buffer-local 'View-process-status-command)
|
|
|
94
|
|
|
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.")
|
|
|
98
|
|
|
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.")
|
|
|
102
|
|
|
103 (defvar View-process-status-last-command-switches nil
|
|
|
104 "Switches of the last `View-process-status-command'.
|
|
|
105 The variable is buffer local.")
|
|
|
106
|
|
|
107 (make-variable-buffer-local 'View-process-status-last-command-switches)
|
|
|
108
|
|
|
109 (defvar View-process-signal-command "kill"
|
|
|
110 "*Command which sends a signal to a process (kill).
|
|
|
111 The variable is buffer local.")
|
|
|
112
|
|
|
113 (make-variable-buffer-local 'View-process-signal-command)
|
|
|
114
|
|
|
115 (defvar View-process-renice-command "renice"
|
|
|
116 "*Command which alter priority of running processes.")
|
|
|
117
|
|
|
118 (make-variable-buffer-local 'View-process-renice-command)
|
|
|
119
|
|
|
120 (defvar View-process-default-nice-value "4"
|
|
|
121 "*Default nice value for altering the priority of running processes.")
|
|
|
122
|
|
|
123 (defvar View-process-rsh-command "rsh"
|
|
|
124 "*Remote shell command (rsh).
|
|
|
125 The variable is buffer local.")
|
|
|
126
|
|
|
127 (make-variable-buffer-local 'View-process-rsh-command)
|
|
|
128
|
|
|
129 (defvar View-process-uname-command "uname"
|
|
|
130 "*The uname command (It returns the system name).
|
|
|
131 The variable is buffer local.")
|
|
|
132
|
|
|
133 (make-variable-buffer-local 'View-process-uname-command)
|
|
|
134
|
|
|
135 (defvar View-process-uname-switches "-sr"
|
|
|
136 "*Switches for uname, so that it returns the sysname and the release.")
|
|
|
137
|
|
|
138 (defvar View-process-test-command "test"
|
|
|
139 "*The test command.")
|
|
|
140
|
|
|
141 (make-variable-buffer-local 'View-process-test-command)
|
|
|
142
|
|
|
143 (defvar View-process-test-switches "-x"
|
|
|
144 "*Switches for test, to test if an executable exists.")
|
|
|
145
|
|
|
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.")
|
|
|
150
|
|
|
151 (make-variable-buffer-local 'View-process-uptime-command)
|
|
|
152
|
|
|
153 (defvar View-process-buffer-name "*ps*"
|
|
|
154 "Name of the output buffer for the 'View-process-mode'.
|
|
|
155 The variable is buffer local.")
|
|
|
156
|
|
|
157 (make-variable-buffer-local 'View-process-buffer-name)
|
|
|
158
|
|
|
159 (defvar View-process-mode-hook nil
|
|
|
160 "*This hook is run after reading in the processes.")
|
|
|
161
|
|
|
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.")
|
|
|
165
|
|
|
166 (make-variable-buffer-local 'View-process-motion-help)
|
|
|
167
|
|
|
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.")
|
|
|
172
|
|
|
173 (defvar View-process-hide-header t
|
|
|
174 "*The header lines in the view processes buffer are hide, if this is t.")
|
|
|
175
|
|
|
176 (make-variable-buffer-local 'View-process-hide-header)
|
|
|
177
|
|
|
178 (defvar View-process-truncate-lines t
|
|
|
179 "*Truncates the liens in the view process buffer if t.")
|
|
|
180
|
|
|
181 (make-variable-buffer-local 'View-process-truncate-lines)
|
|
|
182
|
|
|
183 (defvar View-process-display-short-key-descriptions t
|
|
|
184 "*Controls, whether short key descriptions are displayed or not.")
|
|
|
185
|
|
|
186 (defvar View-process-display-uptime t
|
|
|
187 "*Controls, whether the uptime is displayed or not.")
|
|
|
188
|
|
|
189 (defvar View-process-use-font-lock t
|
|
|
190 "*Determines, if the `font-lock-mode' should be used or not.")
|
|
|
191
|
|
|
192 (defvar View-process-ps-header-window-offset 2
|
|
|
193 "Offset for the size of the ps header window.")
|
|
|
194
|
|
|
195 (defvar View-process-ps-header-window-size 0
|
|
|
196 "Internal variable. The size of the window with the *ps header* buffer.")
|
|
|
197
|
|
|
198 (make-variable-buffer-local 'View-process-ps-header-window-size)
|
|
|
199
|
|
|
200 (defvar View-process-stop-motion-help nil
|
|
|
201 "Internal variable. Stops motion help temporarily.")
|
|
|
202
|
|
|
203 (defvar View-process-deleted-lines nil
|
|
|
204 "Internal variable. A list with lines, which are deleted by a filter.")
|
|
|
205
|
|
|
206 (make-variable-buffer-local 'View-process-deleted-lines)
|
|
|
207
|
|
|
208 (defvar View-process-header-buffer-name "*ps header*"
|
|
|
209 "Name of the view process header buffer.")
|
|
|
210
|
|
|
211 (make-variable-buffer-local 'View-process-header-buffer-name)
|
|
|
212
|
|
|
213 (defvar View-process-header-mode-name "psheader"
|
|
|
214 "Name of the `view process header mode'.")
|
|
|
215
|
|
|
216 (defvar View-process-header-mode-hook nil
|
|
|
217 "*This hook is run after building the header buffer.")
|
|
|
218
|
|
|
219 (defvar View-process-header-mode-line-off t
|
|
|
220 "t means do not display modeline in view-process-header-mode.
|
|
|
221 This does only work in the XEmacs 19.12 or higher.")
|
|
|
222
|
|
|
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 prodices header lines with strings, that are not in this list.")
|
|
|
228
|
|
|
229 (defvar View-process-header-line-background "yellow"
|
|
|
230 "*Background color of the header line.")
|
|
|
231
|
|
|
232 (defvar View-process-header-line-foreground "blue"
|
|
|
233 "*Foreground color of the header line.")
|
|
|
234
|
|
|
235 (defvar View-process-header-line-font (face-font 'bold)
|
|
|
236 "*Font of the header line")
|
|
|
237
|
|
|
238 (defvar View-process-header-line-underline-p t
|
|
|
239 "*T, if the header line should be underlined.")
|
|
|
240
|
|
|
241 (defvar View-process-no-mark ?_
|
|
|
242 "*A character with specifies, that a line isn't marked.")
|
|
|
243
|
|
|
244 (defvar View-process-signaled-line-background nil
|
|
|
245 "*Background color of the line with a signaled or reniced process.")
|
|
|
246
|
|
|
247 (defvar View-process-signaled-line-foreground "grey80"
|
|
|
248 "*Foreground color of the line with a signaled or reniced process.")
|
|
|
249
|
|
|
250 (defvar View-process-signaled-line-font (face-font 'italic)
|
|
|
251 "*Font of the line with a signaled or reniced process.")
|
|
|
252
|
|
|
253 (defvar View-process-signaled-line-underline-p nil
|
|
|
254 "*T, if the \"signaled line\" should be underlined.")
|
|
|
255
|
|
|
256 (defvar View-process-signaled-line-mark ?s
|
|
|
257 "*A character, which is used as a mark for \"signaled lines\".")
|
|
|
258
|
|
|
259 (defvar View-process-signal-line-background nil
|
|
|
260 "*Background color of the line with the process which should be signaled.")
|
|
|
261
|
|
|
262 (defvar View-process-signal-line-foreground "red"
|
|
|
263 "*Foreground color of the line with the process which should be signaled.")
|
|
|
264
|
|
|
265 (defvar View-process-signal-line-font (face-font 'bold)
|
|
|
266 "*Font of the line with the process which should be signaled.")
|
|
|
267
|
|
|
268 (defvar View-process-signal-line-underline-p nil
|
|
|
269 "*T, if the \"signal line\" should be underlined.")
|
|
|
270
|
|
|
271 (defvar View-process-signal-line-mark ?K
|
|
|
272 "*A character, which is used as a mark for \"signal lines\".")
|
|
|
273
|
|
|
274 (defvar View-process-renice-line-background nil
|
|
|
275 "*Background color of the line with the process which should be reniced.")
|
|
|
276
|
|
|
277 (defvar View-process-renice-line-foreground "red"
|
|
|
278 "*Foreground color of the line with the process which should be reniced.")
|
|
|
279
|
|
|
280 (defvar View-process-renice-line-font (face-font 'bold)
|
|
|
281 "*Font of the line with the process which should be reniced.")
|
|
|
282
|
|
|
283 (defvar View-process-renice-line-underline-p nil
|
|
|
284 "*T, if the \"renice line\" should be underlined.")
|
|
|
285
|
|
|
286 (defvar View-process-renice-line-mark ?N
|
|
|
287 "*A character, which is used as a mark for \"renice lines\".")
|
|
|
288
|
|
|
289 (defvar View-process-child-line-background nil
|
|
|
290 "*Background color of a line with a child process.")
|
|
|
291
|
|
|
292 (defvar View-process-child-line-foreground "darkviolet"
|
|
|
293 "*Foreground color of a line with a child process.")
|
|
|
294
|
|
|
295 (defvar View-process-child-line-font (face-font 'italic)
|
|
|
296 "*Font color of a line with a child process.")
|
|
|
297
|
|
|
298 (defvar View-process-child-line-underline-p nil
|
|
|
299 "*T, if the \"line with a child process\" should be underlined.")
|
|
|
300
|
|
|
301 (defvar View-process-child-line-mark ?C
|
|
|
302 "*A character, which is used as a mark for child processes.")
|
|
|
303
|
|
|
304 (defvar View-process-parent-line-background "LightBlue"
|
|
|
305 "*Background color of a line with a parent process.")
|
|
|
306
|
|
|
307 (defvar View-process-parent-line-foreground "darkviolet"
|
|
|
308 "*Foreground color of a line with a parent process.")
|
|
|
309
|
|
|
310 (defvar View-process-parent-line-font (face-font 'bold)
|
|
|
311 "*Font color of a line with a parent process.")
|
|
|
312
|
|
|
313 (defvar View-process-parent-line-underline-p t
|
|
|
314 "*T, if the \"line with a parent\" should be underlined.")
|
|
|
315
|
|
|
316 (defvar View-process-parent-line-mark ?P
|
|
|
317 "*A character, which is used as a mark for parent processes.")
|
|
|
318
|
|
|
319 (defvar View-process-single-line-background nil
|
|
|
320 "*Background color of a line with a single line mark.")
|
|
|
321
|
|
|
322 (defvar View-process-single-line-foreground "darkblue"
|
|
|
323 "*Foreground color of a line with a single line mark.")
|
|
|
324
|
|
|
325 (defvar View-process-single-line-font (face-font 'bold)
|
|
|
326 "*Font color of a line with a single line mark.")
|
|
|
327
|
|
|
328 (defvar View-process-single-line-underline-p t
|
|
|
329 "*T, if the \"line with a single line mark\" should be underlined.")
|
|
|
330
|
|
|
331 (defvar View-process-single-line-mark ?*
|
|
|
332 "*A character, which is used as a single line mark.")
|
|
|
333
|
|
|
334 (defvar View-process-font-lock-keywords
|
|
|
335 (list
|
|
|
336 (cons (concat "^"
|
|
|
337 (char-to-string View-process-child-line-mark)
|
|
|
338 " .*")
|
|
|
339 'View-process-child-line-face)
|
|
|
340 (cons (concat "^"
|
|
|
341 (char-to-string View-process-parent-line-mark)
|
|
|
342 " .*")
|
|
|
343 'View-process-parent-line-face)
|
|
|
344 (cons (concat "^\\"
|
|
|
345 (char-to-string View-process-single-line-mark)
|
|
|
346 " .*")
|
|
|
347 'View-process-single-line-face)
|
|
|
348 (cons (concat "^"
|
|
|
349 (char-to-string View-process-signaled-line-mark)
|
|
|
350 " .*")
|
|
|
351 'View-process-signaled-line-face)
|
|
|
352 (cons (concat "^"
|
|
|
353 (char-to-string View-process-signal-line-mark)
|
|
|
354 " .*")
|
|
|
355 'View-process-signal-line-face)
|
|
|
356 (cons (concat "^"
|
|
|
357 (char-to-string View-process-renice-line-mark)
|
|
|
358 " .*")
|
|
|
359 'View-process-renice-line-face)
|
|
|
360 )
|
|
|
361 "The font lock keywords for the `View-process-mode'."
|
|
|
362 )
|
|
|
363
|
|
|
364 (defvar View-process-pid-mark-alist nil
|
|
|
365 "Internal variable. An alist with marks and pids.")
|
|
|
366
|
|
|
367 (make-variable-buffer-local 'View-process-pid-mark-alist)
|
|
|
368
|
|
|
369 (defvar View-process-last-pid-mark-alist nil
|
|
|
370 "Internal variable. An alist withthe last marks and pids.")
|
|
|
371
|
|
|
372 (make-variable-buffer-local 'View-process-last-pid-mark-alist)
|
|
|
373
|
|
|
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 create 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.
|
|
|
388
|
|
|
389 The cdr of each sublist depends on the keyword. The following shows
|
|
|
390 the syntax of the different sublist types:
|
|
|
391 (sort <fieldname>)
|
|
|
392 (filter <fieldname> <regexp>)
|
|
|
393 (exclude-filter <fieldname> <regexp>)
|
|
|
394 (grep <regexp>)
|
|
|
395 (exclude-grep <regexp>)
|
|
|
396 (reverse)
|
|
|
397
|
|
|
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.")
|
|
|
401
|
|
|
402 (defvar View-process-actual-sorter-and-filter nil
|
|
|
403 "Internal variable. It holds the actual sorter and filter commands.
|
|
|
404 Don't change it!")
|
|
|
405
|
|
|
406 (make-variable-buffer-local 'View-process-actual-sorter-and-filter)
|
|
|
407
|
|
|
408 (defvar View-process-itimer-value 5
|
|
|
409 "*Value of the view process itimer.")
|
|
|
410
|
|
|
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.")
|
|
|
414
|
|
|
415 (make-variable-buffer-local 'View-process-system-type)
|
|
|
416
|
|
|
417 (defvar View-process-remote-host nil
|
|
|
418 "Internal variable. Name of the remote host or nil.
|
|
|
419 The variable is buffer local.")
|
|
|
420
|
|
|
421 (make-variable-buffer-local 'View-process-remote-host)
|
|
|
422
|
|
|
423 (defvar View-process-header-start nil
|
|
|
424 "Internal variable. Start of the ps output header line.
|
|
|
425 The variable is buffer local.")
|
|
|
426
|
|
|
427 (make-variable-buffer-local 'View-process-header-start)
|
|
|
428
|
|
|
429 (defvar View-process-header-end nil
|
|
|
430 "Internal variable. End of the ps output header line.
|
|
|
431 The variable is buffer local.")
|
|
|
432
|
|
|
433 (make-variable-buffer-local 'View-process-header-end)
|
|
|
434
|
|
|
435 (defvar View-process-output-start nil
|
|
|
436 "Internal variable. Start of the ps output (after the header).
|
|
|
437 The variable is buffer local.")
|
|
|
438
|
|
|
439 (make-variable-buffer-local 'View-process-output-start)
|
|
|
440
|
|
|
441 (defvar View-process-output-end nil
|
|
|
442 "Internal variable. End of the ps output (after the header).
|
|
|
443 The variable is buffer local.")
|
|
|
444
|
|
|
445 (make-variable-buffer-local 'View-process-output-end)
|
|
|
446
|
|
|
447 (defvar View-process-old-window-configuration nil
|
|
|
448 "Internal variable. Window configuration before the first ps command.")
|
|
|
449
|
|
|
450 (make-variable-buffer-local 'View-process-old-window-configuration)
|
|
|
451
|
|
|
452 (defvar View-process-max-fields nil
|
|
|
453 "Internal variable. Number of output fields.
|
|
|
454 The variable is buffer local.")
|
|
|
455
|
|
|
456 (make-variable-buffer-local 'View-process-max-fields)
|
|
|
457
|
|
|
458 (defvar View-process-field-names nil
|
|
|
459 "Internal variable. An alist with the fieldnames and fieldnumbers.
|
|
|
460 The variable is buffer local.")
|
|
|
461
|
|
|
462 (make-variable-buffer-local 'View-process-max-fields)
|
|
|
463
|
|
|
464 (defvar View-process-field-blanks-already-replaced nil
|
|
|
465 "Internal variable. It is t, if blanks in fields are already replaced.")
|
|
|
466
|
|
|
467 (make-variable-buffer-local 'View-process-field-blanks-already-replaced)
|
|
|
468
|
|
|
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 initialised each time after running ps.
|
|
|
473 The variable is buffer local.")
|
|
|
474
|
|
|
475 (make-variable-buffer-local 'View-process-kill-signals)
|
|
|
476
|
|
|
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.")
|
|
|
489
|
|
|
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'!")
|
|
|
493
|
|
|
494 (defvar View-process-pid-field-name "PID"
|
|
|
495 "*The name of the field with the PID's.
|
|
|
496 The name must be the same as in the first outputline of the
|
|
|
497 command `View-process-status-command' (ps).
|
|
|
498 The variable is buffer local.")
|
|
|
499
|
|
|
500 (make-variable-buffer-local 'View-process-pid-field-name)
|
|
|
501
|
|
|
502 (defvar View-process-ppid-field-name "PPID"
|
|
|
503 "*The name of the field with the PPID's.
|
|
|
504 The name must be the same as in the first outputline of the
|
|
|
505 command `View-process-status-command' (ps).
|
|
|
506 The variable is buffer local.")
|
|
|
507
|
|
|
508 (make-variable-buffer-local 'View-process-ppid-field-name)
|
|
|
509
|
|
|
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>
|
|
|
515 <kill-signals>))
|
|
|
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\"
|
|
|
521 nil
|
|
|
522 View-process-kill-signals-linux
|
|
|
523 ))
|
|
|
524 (\"cesar\" (nil nil \"bsd\"))
|
|
|
525 The list will be anhanced 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."
|
|
|
529 )
|
|
|
530
|
|
|
531 (defvar View-process-status-history nil
|
|
|
532 "A list with the command switch history of the status command (ps).")
|
|
|
533
|
|
|
534 (defvar View-process-remote-host-history nil
|
|
|
535 "A list with the remote host history.")
|
|
|
536
|
|
|
537 (defvar View-process-field-name-history nil
|
|
|
538 "A list with the field name history.")
|
|
|
539
|
|
|
540 (defvar View-process-filter-history nil
|
|
|
541 "A list with the filter history.")
|
|
|
542
|
|
|
543 (defvar View-process-signal-history nil
|
|
|
544 "A list with the signal history.")
|
|
|
545
|
|
|
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 initialised each time after running ps.
|
|
|
550 The variable is buffer local.")
|
|
|
551
|
|
|
552 (make-variable-buffer-local 'View-process-field-name-descriptions)
|
|
|
553
|
|
|
554 (defvar View-process-field-name-descriptions-general
|
|
|
555 '(
|
|
|
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.")
|
|
|
561 ("F" ("Status= "
|
|
|
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.")
|
|
|
579 ("STAT" ("Status. "
|
|
|
580 ("R" "R=runnable. ")
|
|
|
581 ("S" "S=sleeping. ")
|
|
|
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. ")
|
|
|
588 ))
|
|
|
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")))
|
|
|
595 ("UID" "User Id.")
|
|
|
596 ("USER" "Owner of the process.")
|
|
|
597 ("WCHAN" "Name of the kernel function where the process is sleeping.")
|
|
|
598 )
|
|
|
599 "Help list with the descriptions of ps fields.
|
|
|
600 This is a general list, which should be true for many systems.
|
|
|
601 This list will only be used, if there is no entry in a special
|
|
|
602 list for the system.")
|
|
|
603
|
|
|
604 (defvar View-process-insert-blank-alist
|
|
|
605 '(("SZ" behind-predecessor 0)
|
|
|
606 ("SIZE" behind-predecessor 0)
|
|
|
607 ("RSS" behind-predecessor 0)
|
|
|
608 ("START" behind 1))
|
|
|
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
|
|
|
614 following values:
|
|
|
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.")
|
|
|
620
|
|
|
621 (defvar View-process-mode-syntax-table nil
|
|
|
622 "Syntax table for the `View-process-mode'.")
|
|
|
623
|
|
|
624 (if (not View-process-mode-syntax-table)
|
|
|
625 (let ((i 0))
|
|
|
626 (setq View-process-mode-syntax-table (make-syntax-table))
|
|
|
627 (setq i ?!)
|
|
|
628 (while (<= i ?#)
|
|
|
629 (modify-syntax-entry i "w" View-process-mode-syntax-table)
|
|
|
630 (setq i (1+ i)))
|
|
|
631 (modify-syntax-entry ?, "w" View-process-mode-syntax-table)
|
|
|
632 (modify-syntax-entry ?. "w" View-process-mode-syntax-table)
|
|
|
633 (setq i ?:)
|
|
|
634 (while (<= i ?\;)
|
|
|
635 (modify-syntax-entry i "w" View-process-mode-syntax-table)
|
|
|
636 (setq i (1+ i)))
|
|
|
637 (setq i ??)
|
|
|
638 (while (<= i ?@)
|
|
|
639 (modify-syntax-entry i "w" View-process-mode-syntax-table)
|
|
|
640 (setq i (1+ i)))
|
|
|
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)
|
|
|
647 ))
|
|
|
648
|
|
|
649 (defvar View-process-digit-bindings-send-signal nil
|
|
|
650 "The digits 1 to 9 will be bind to send signal commands, if t.")
|
|
|
651
|
|
|
652 (defvar View-process-mode-mark-map nil
|
|
|
653 "Local subkeymap for View-process-mode buffers.")
|
|
|
654
|
|
|
655 (if View-process-mode-mark-map
|
|
|
656 nil
|
|
|
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-childs-in-current-line)
|
|
|
663 (define-key View-process-mode-mark-map "l" 'View-process-reset-last-marks)
|
|
|
664 )
|
|
|
665
|
|
|
666 (defvar View-process-mode-i-map nil
|
|
|
667 "Local subkeymap for View-process-mode buffers.")
|
|
|
668
|
|
|
669 (if View-process-mode-i-map
|
|
|
670 nil
|
|
|
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)
|
|
|
674 )
|
|
|
675
|
|
|
676 (defvar View-process-mode-comma-map nil
|
|
|
677 "Local subkeymap for View-process-mode buffers.")
|
|
|
678
|
|
|
679 (if View-process-mode-comma-map
|
|
|
680 nil
|
|
|
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))
|
|
|
686
|
|
|
687 (defvar View-process-mode-period-map nil
|
|
|
688 "Local subkeymap for View-process-mode buffers.")
|
|
|
689
|
|
|
690 (if View-process-mode-period-map
|
|
|
691 nil
|
|
|
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))
|
|
|
707
|
|
|
708
|
|
|
709 (defvar View-process-mode-map nil
|
|
|
710 "Local keymap for View-process-mode buffers.")
|
|
|
711
|
|
|
712 (if View-process-mode-map
|
|
|
713 nil
|
|
|
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)
|
|
|
770 )
|
|
|
771
|
|
|
772 (defvar View-process-pulldown-menu-name "Processes"
|
|
|
773 "Name of the pulldown menu in the `View-process-mode'.")
|
|
|
774
|
|
|
775 (defvar View-process-pulldown-menu nil
|
|
|
776 "Pulldown menu list for the `View-process-mode'.")
|
|
|
777
|
|
|
778 (defvar View-process-region-menu nil
|
|
|
779 "Menu list for the `View-process-mode', used if a region is active.")
|
|
|
780
|
|
|
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.")
|
|
|
784
|
|
|
785 (defvar View-process-non-region-menu nil
|
|
|
786 "Menu list for the `View-process-mode', used if a region is not active.")
|
|
|
787
|
|
|
788 (defvar View-process-mode-name "Processes"
|
|
|
789 "Name of the `view process mode'.")
|
|
|
790
|
|
|
791 (defun View-process-make-field-postition-alist-1 ()
|
|
|
792 "Internal function of View-process-make-field-postition-alist."
|
|
|
793 (if (>= (point) View-process-header-end)
|
|
|
794 nil
|
|
|
795 (let (start 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-postition-alist-1))))
|
|
|
802 )
|
|
|
803
|
|
|
804 (defun View-process-make-field-postition-alist ()
|
|
|
805 "Returns an alist with the start and end positions of each field.
|
|
|
806 The list looks like ((start1 end1) (start2 end2) ...)."
|
|
|
807 (save-restriction
|
|
|
808 (widen)
|
|
|
809 (goto-char View-process-header-start)
|
|
|
810 (View-process-make-field-postition-alist-1)))
|
|
|
811
|
|
|
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)))
|
|
|
816 (save-excursion
|
|
|
817 (goto-char region-begin)
|
|
|
818 (while (> region-end (point))
|
|
|
819 (delete-char 1)
|
|
|
820 (View-process-insert-and-inherit char)))))
|
|
|
821
|
|
|
822 (defun View-process-replaces-blanks-in-the-fields-of-this-line
|
|
|
823 (field-position-alist)
|
|
|
824 "Replaces the blanks in the fields of this line with underscores.
|
|
|
825 FIELD-POSITION-ALIST is an alist with the name and the
|
|
|
826 aproximated 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)
|
|
|
833 (car (car
|
|
|
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)
|
|
|
839 (delete-char 1)
|
|
|
840 (View-process-insert-and-inherit "_"))
|
|
|
841 (let ((search-result (search-forward-regexp "[ ]+" field-end t))
|
|
|
842 (match-beginning nil))
|
|
|
843 (if search-result
|
|
|
844 (if (not (= search-result field-end))
|
|
|
845 (View-process-overwrite-chars-in-region (match-beginning 0)
|
|
|
846 (match-end 0)
|
|
|
847 ?_)
|
|
|
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
|
|
|
852 match-beginning
|
|
|
853 (match-beginning 0)
|
|
|
854 ?_))))
|
|
|
855 ))
|
|
|
856 (View-process-replaces-blanks-in-the-fields-of-this-line
|
|
|
857 (cdr field-position-alist)))))
|
|
|
858
|
|
|
859 (defun View-process-replaces-blanks-in-fields ()
|
|
|
860 "Replaces the blanks in fields with underscrores."
|
|
|
861 (save-excursion
|
|
|
862 (save-window-excursion
|
|
|
863 (let ((field-position-alist (View-process-make-field-postition-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)
|
|
|
868 (beginning-of-line)
|
|
|
869 (View-process-replaces-blanks-in-the-fields-of-this-line
|
|
|
870 field-position-alist)
|
|
|
871 (forward-line))
|
|
|
872 (setq buffer-read-only read-only)))))
|
|
|
873
|
|
|
874 (defun View-process-replaces-blanks-in-fields-if-necessary ()
|
|
|
875 "Replaces blanks in fields, if necessary.
|
|
|
876 For that it checks `View-process-field-blanks-already-replaced'."
|
|
|
877 (if View-process-field-blanks-already-replaced
|
|
|
878 nil
|
|
|
879 (View-process-replaces-blanks-in-fields)
|
|
|
880 (setq View-process-field-blanks-already-replaced t)))
|
|
|
881
|
|
|
882 (defun View-process-insert-column-in-region (char
|
|
|
883 column
|
|
|
884 begin
|
|
|
885 end
|
|
|
886 &optional overwrite
|
|
|
887 not-looking-at)
|
|
|
888 "Inserts 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 insertation will only be done, if NOT-LOOKING-AT
|
|
|
894 isn't a string starting at the column."
|
|
|
895 (save-excursion
|
|
|
896 (let ((no-of-lines (count-lines begin end))
|
|
|
897 (line 1))
|
|
|
898 (goto-char begin)
|
|
|
899 (beginning-of-line)
|
|
|
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)) ? )))
|
|
|
905 (if overwrite
|
|
|
906 (progn
|
|
|
907 (delete-char -1)
|
|
|
908 (View-process-insert-and-inherit char))
|
|
|
909 (if (or (not not-looking-at)
|
|
|
910 (not (looking-at not-looking-at)))
|
|
|
911 (progn
|
|
|
912 (View-process-insert-and-inherit char)
|
|
|
913 (forward-char -1)
|
|
|
914 )))
|
|
|
915 (forward-line 1)
|
|
|
916 (setq line (1+ line))))))
|
|
|
917
|
|
|
918 (defun View-process-insert-blank-in-column (column
|
|
|
919 &optional overwrite
|
|
|
920 not-looking-at)
|
|
|
921 "Inserts 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 insertation 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 ?
|
|
|
929 column
|
|
|
930 View-process-header-start
|
|
|
931 View-process-output-end
|
|
|
932 overwrite
|
|
|
933 not-looking-at)
|
|
|
934 (setq View-process-output-end (point-max))
|
|
|
935 (setq buffer-read-only read-only)))
|
|
|
936
|
|
|
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."
|
|
|
940 ; (save-excursion
|
|
|
941 ; (goto-char View-process-header-start)
|
|
|
942 ; (insert "m ")
|
|
|
943 ; (forward-line)
|
|
|
944 ; (while (< (point) View-process-output-end)
|
|
|
945 ; (insert "_ ")
|
|
|
946 ; (forward-line))))
|
|
|
947
|
|
|
948 (defun View-process-insert-blanks-at-line-start ()
|
|
|
949 "Inserts some blanks at the beginning of each output line.
|
|
|
950 This space is used for the marks."
|
|
|
951 (save-excursion
|
|
|
952 (goto-char View-process-output-end)
|
|
|
953 (forward-line -1)
|
|
|
954 (while (> (point) View-process-header-start)
|
|
|
955 (insert "_ ")
|
|
|
956 (forward-line -1))
|
|
|
957 (insert "m ")))
|
|
|
958
|
|
|
959 (defun View-process-return-position (field-name position-descriptor)
|
|
|
960 "Returns a position deppending 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."
|
|
|
964 (save-excursion
|
|
|
965 (goto-char View-process-header-start)
|
|
|
966 (beginning-of-line)
|
|
|
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 " ")
|
|
|
971 (current-column))
|
|
|
972 ((eq position-descriptor 'behind)
|
|
|
973 (current-column))
|
|
|
974 ((eq position-descriptor 'in-front)
|
|
|
975 (goto-char (match-beginning 0))
|
|
|
976 (current-column))
|
|
|
977 ((eq position-descriptor 'in-front-successor)
|
|
|
978 (skip-chars-forward " ")
|
|
|
979 (current-column))))))
|
|
|
980
|
|
|
981 (defun View-process-split-merged-fields (insert-blank-alist)
|
|
|
982 "Tries 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))))))
|
|
|
990 (if position
|
|
|
991 (View-process-insert-blank-in-column
|
|
|
992 (+ position
|
|
|
993 (car (cdr (cdr (car insert-blank-alist)))))
|
|
|
994 nil
|
|
|
995 "[^ ][^ ]? ")))
|
|
|
996 (View-process-split-merged-fields (cdr insert-blank-alist)))
|
|
|
997 (t)))
|
|
|
998
|
|
|
999 (defun View-process-replace-colons-with-blanks ()
|
|
|
1000 "Replaces colons with blanks, if a colon is also in the header line.
|
|
|
1001 This fixes the output of the IRIX ps on SGI's."
|
|
|
1002 (save-excursion
|
|
|
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)
|
|
|
1006 t))))
|
|
|
1007
|
|
|
1008 (defun View-process-mode ()
|
|
|
1009 "Mode for displaying and killing processes.
|
|
|
1010 The mode has the following keybindings:
|
|
|
1011 \\{View-process-mode-map}.
|
|
|
1012
|
|
|
1013 The first column of each outputline 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):
|
|
|
1016
|
|
|
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.
|
|
|
1025
|
|
|
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)
|
|
|
1046 )
|
|
|
1047
|
|
|
1048 (defun View-process-build-field-name-list ()
|
|
|
1049 "Returns 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)
|
|
|
1052 (forward-word 1)
|
|
|
1053 (setq View-process-field-names '())
|
|
|
1054 (let ((i 1))
|
|
|
1055 (while (<= (point) View-process-header-end)
|
|
|
1056 (setq View-process-field-names (cons (list (current-word) i)
|
|
|
1057 View-process-field-names))
|
|
|
1058 (setq i (1+ i))
|
|
|
1059 (forward-word 1))))
|
|
|
1060
|
|
|
1061 (defun View-process-field-name-exists-p (field-name)
|
|
|
1062 "Returns non nil, if the field FIELD_NAME exists."
|
|
|
1063 (assoc field-name View-process-field-names))
|
|
|
1064
|
|
|
1065 (defun View-process-translate-field-name-to-position (field-name)
|
|
|
1066 "Returns the position of the field with the name FIELD-NAME."
|
|
|
1067 (car (cdr (assoc field-name View-process-field-names)))
|
|
|
1068 )
|
|
|
1069
|
|
|
1070 (defun View-process-translate-field-position-to-name (position)
|
|
|
1071 "Returns 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))
|
|
|
1076 ))
|
|
|
1077
|
|
|
1078 (defun View-process-get-system-type-from-host-list (host-name)
|
|
|
1079 "Returns 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))))
|
|
|
1081
|
|
|
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))))
|
|
|
1090
|
|
|
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
|
|
|
1095 be tested."
|
|
|
1096 (if remote-host
|
|
|
1097 (if (eq 0 (call-process View-process-rsh-command
|
|
|
1098 nil
|
|
|
1099 nil
|
|
|
1100 nil
|
|
|
1101 remote-host
|
|
|
1102 (concat View-process-status-command
|
|
|
1103 " "
|
|
|
1104 "-dfj")))
|
|
|
1105 "system-v"
|
|
|
1106 "bsd")
|
|
|
1107 (if (eq 0 (call-process View-process-status-command
|
|
|
1108 nil
|
|
|
1109 nil
|
|
|
1110 nil
|
|
|
1111 "-dfj"))
|
|
|
1112 "system-v"
|
|
|
1113 "bsd")))
|
|
|
1114
|
|
|
1115 (defun View-process-program-exists-p (program &optional remote-host)
|
|
|
1116 "Returns t, if the PROGRAM exists.
|
|
|
1117 If REMOTE_HOST is non nil, then the program will be searched remote
|
|
|
1118 on that host."
|
|
|
1119 (if remote-host
|
|
|
1120 (or (= 0 (call-process View-process-rsh-command
|
|
|
1121 nil
|
|
|
1122 nil
|
|
|
1123 nil
|
|
|
1124 remote-host
|
|
|
1125 (concat View-process-test-command
|
|
|
1126 " "
|
|
|
1127 View-process-test-switches
|
|
|
1128 " "
|
|
|
1129 program)))
|
|
|
1130 (= 0 (call-process View-process-rsh-command
|
|
|
1131 nil
|
|
|
1132 nil
|
|
|
1133 nil
|
|
|
1134 remote-host
|
|
|
1135 (concat View-process-test-command
|
|
|
1136 " "
|
|
|
1137 View-process-test-switches
|
|
|
1138 " "
|
|
|
1139 "/bin/"
|
|
|
1140 program)))
|
|
|
1141 (= 0 (call-process View-process-rsh-command
|
|
|
1142 nil
|
|
|
1143 nil
|
|
|
1144 nil
|
|
|
1145 remote-host
|
|
|
1146 (concat View-process-test-command
|
|
|
1147 " "
|
|
|
1148 View-process-test-switches
|
|
|
1149 " "
|
|
|
1150 "/usr/bin/"
|
|
|
1151 program))))
|
|
|
1152 (or (= 0 (call-process View-process-test-command
|
|
|
1153 nil
|
|
|
1154 nil
|
|
|
1155 nil
|
|
|
1156 View-process-test-switches
|
|
|
1157 program))
|
|
|
1158 (= 0 (call-process View-process-test-command
|
|
|
1159 nil
|
|
|
1160 nil
|
|
|
1161 nil
|
|
|
1162 View-process-test-switches
|
|
|
1163 (concat "/bin/" program)))
|
|
|
1164 (= 0 (call-process View-process-test-command
|
|
|
1165 nil
|
|
|
1166 nil
|
|
|
1167 nil
|
|
|
1168 View-process-test-switches
|
|
|
1169 (concat "/usr/bin/" program))))))
|
|
|
1170
|
|
|
1171 (defun View-process-search-system-type-in-system-list-1 (system-type
|
|
|
1172 system-list)
|
|
|
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
|
|
|
1178 system-type
|
|
|
1179 (cdr system-list))))
|
|
|
1180 (t (View-process-search-system-type-in-system-list-1 system-type
|
|
|
1181 (cdr system-list))
|
|
|
1182 )))
|
|
|
1183
|
|
|
1184 (defun View-process-search-system-type-in-system-list (system-type system-list)
|
|
|
1185 "Searches 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
|
|
|
1191 (car system-type)
|
|
|
1192 system-list)))
|
|
|
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))
|
|
|
1197 nil)))
|
|
|
1198
|
|
|
1199
|
|
|
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
|
|
|
1211 system-type
|
|
|
1212 View-process-specific-system-list)))
|
|
|
1213 (if new-system-type
|
|
|
1214 new-system-type
|
|
|
1215 (list nil nil (View-process-bsd-or-system-v)))))
|
|
|
1216
|
|
|
1217 (defun View-process-get-local-system-type ()
|
|
|
1218 "Returns the system type of the local host."
|
|
|
1219 (let ((system-type (View-process-get-system-type-from-host-list
|
|
|
1220 (system-name))))
|
|
|
1221 (if (not system-type) ; t, if the host isn't in the list
|
|
|
1222 (progn
|
|
|
1223 (if (View-process-program-exists-p View-process-uname-command)
|
|
|
1224 (save-excursion
|
|
|
1225 (let ((buffer (generate-new-buffer "*system-type*")))
|
|
|
1226 (call-process View-process-uname-command
|
|
|
1227 nil
|
|
|
1228 buffer
|
|
|
1229 nil
|
|
|
1230 View-process-uname-switches)
|
|
|
1231 (set-buffer buffer)
|
|
|
1232 (forward-line -1)
|
|
|
1233 (setq system-type (downcase (current-word)))
|
|
|
1234 (forward-word 2)
|
|
|
1235 (setq system-type
|
|
|
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
|
|
|
1244 system-type))
|
|
|
1245 ))
|
|
|
1246 (setq system-type (list nil nil (View-process-bsd-or-system-v))))
|
|
|
1247 (View-process-put-system-type-in-host-list (system-name)
|
|
|
1248 system-type)
|
|
|
1249 system-type)
|
|
|
1250 system-type)))
|
|
|
1251
|
|
|
1252 (defun View-process-get-remote-system-type ()
|
|
|
1253 "Returns 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
|
|
|
1257 system-type
|
|
|
1258 (if (View-process-program-exists-p View-process-uname-command
|
|
|
1259 View-process-remote-host)
|
|
|
1260 (let ((buffer (generate-new-buffer "*system-type*")))
|
|
|
1261 (save-excursion
|
|
|
1262 (call-process View-process-rsh-command
|
|
|
1263 nil
|
|
|
1264 buffer
|
|
|
1265 nil
|
|
|
1266 View-process-remote-host
|
|
|
1267 (concat View-process-uname-command
|
|
|
1268 " "
|
|
|
1269 View-process-uname-switches))
|
|
|
1270 (set-buffer buffer)
|
|
|
1271 (forward-line -1)
|
|
|
1272 (setq system-type (downcase (current-word)))
|
|
|
1273 (forward-word 2)
|
|
|
1274 (setq system-type
|
|
|
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
|
|
|
1283 system-type
|
|
|
1284 View-process-remote-host))
|
|
|
1285 ))
|
|
|
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
|
|
|
1289 system-type)
|
|
|
1290 system-type)))
|
|
|
1291
|
|
|
1292 (defun View-process-get-system-type ()
|
|
|
1293 "Returns 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)
|
|
|
1297 ))
|
|
|
1298
|
|
|
1299 (defun View-process-get-kill-signal-list (system-type)
|
|
|
1300 "Returns 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)))))
|
|
|
1318
|
|
|
1319 (defun View-process-get-field-name-description-list (system-type)
|
|
|
1320 "Returns 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)))))
|
|
|
1335
|
|
|
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)
|
|
|
1343
|
|
|
1344 (goto-char View-process-header-start)
|
|
|
1345 (end-of-line)
|
|
|
1346 (setq View-process-header-end (point))
|
|
|
1347 ;; (newline)
|
|
|
1348 (forward-line)
|
|
|
1349 (setq View-process-output-start (point))
|
|
|
1350 (setq View-process-output-end (point-max))
|
|
|
1351 (goto-char View-process-header-end)
|
|
|
1352 (forward-word -1)
|
|
|
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)
|
|
|
1360 )
|
|
|
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))
|
|
|
1366
|
|
|
1367 (if View-process-pid-mark-alist
|
|
|
1368 (progn
|
|
|
1369 (setq View-process-last-pid-mark-alist View-process-pid-mark-alist)
|
|
|
1370 (setq View-process-pid-mark-alist nil)))
|
|
|
1371 )
|
|
|
1372
|
|
|
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)
|
|
|
1380 (insert
|
|
|
1381 (substitute-command-keys
|
|
|
1382 (concat
|
|
|
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))))
|
|
|
1393
|
|
|
1394 (defun View-process-insert-uptime (&optional remote-host)
|
|
|
1395 "Inserts 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
|
|
|
1399 (progn
|
|
|
1400 ; (newline)
|
|
|
1401 (if remote-host
|
|
|
1402 (call-process View-process-rsh-command
|
|
|
1403 nil
|
|
|
1404 t
|
|
|
1405 nil
|
|
|
1406 remote-host
|
|
|
1407 View-process-uptime-command)
|
|
|
1408 (call-process View-process-uptime-command
|
|
|
1409 nil
|
|
|
1410 t
|
|
|
1411 nil)))))
|
|
|
1412
|
|
|
1413 (defun View-process-insert-title-lines (command-switches
|
|
|
1414 remote-host
|
|
|
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')
|
|
|
1420 are used."
|
|
|
1421 (insert (or remote-host (system-name) "")
|
|
|
1422 ;;(getenv "HOST") (getenv "HOSTNAME") "")
|
|
|
1423 ", "
|
|
|
1424 (current-time-string)
|
|
|
1425 ", "
|
|
|
1426 View-process-status-command
|
|
|
1427 " "
|
|
|
1428 command-switches
|
|
|
1429 "\n")
|
|
|
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)
|
|
|
1435 (insert
|
|
|
1436 "This output is filtered! Look at `View-process-sorter-and-filter'.\n"))
|
|
|
1437 (newline 1)
|
|
|
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)
|
|
|
1444 -1
|
|
|
1445 0))))
|
|
|
1446
|
|
|
1447 (defun View-process-search-header-line-1 (header-dectection-list
|
|
|
1448 no-error-message)
|
|
|
1449 "Internal funtion of `View-process-search-header-line'."
|
|
|
1450 (cond (header-dectection-list
|
|
|
1451 (goto-char View-process-header-start)
|
|
|
1452 (if (search-forward (car header-dectection-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-dectection-list)
|
|
|
1456 no-error-message)))
|
|
|
1457 (t (setq mode-motion-hook nil) ; otherwise emacs hangs
|
|
|
1458 (if no-error-message
|
|
|
1459 nil
|
|
|
1460 (error (concat "ERROR: No header line detected! "
|
|
|
1461 "Look at View-process-header-line-detection-list!")
|
|
|
1462 )))))
|
|
|
1463
|
|
|
1464
|
|
|
1465 (defun View-process-search-header-line (&optional no-error-message)
|
|
|
1466 "Function searches the headerline and sets `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."
|
|
|
1471 (save-excursion
|
|
|
1472 (View-process-search-header-line-1 View-process-header-line-detection-list
|
|
|
1473 no-error-message)
|
|
|
1474 ))
|
|
|
1475
|
|
|
1476 (defun View-process-save-position ()
|
|
|
1477 "Saves the current line and column in a cons cell and returns it."
|
|
|
1478 (save-restriction
|
|
|
1479 (widen)
|
|
|
1480 (if (< View-process-header-start (point-max))
|
|
|
1481 (cons (- (count-lines (or View-process-header-start (point-min))
|
|
|
1482 (point))
|
|
|
1483 (if (= 0 (current-column))
|
|
|
1484 0
|
|
|
1485 1))
|
|
|
1486 (current-column))
|
|
|
1487 nil)))
|
|
|
1488
|
|
|
1489 (defun View-process-goto-position (position)
|
|
|
1490 "Sets the point to the POSITION.
|
|
|
1491 POSITION is a cons cell with a linenumber and a column."
|
|
|
1492 (if position
|
|
|
1493 (save-restriction
|
|
|
1494 (widen)
|
|
|
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 :-(
|
|
|
1499 )))
|
|
|
1500
|
|
|
1501 (defun View-process-status (command-switches
|
|
|
1502 &optional remote-host
|
|
|
1503 use-last-sorter-and-filter)
|
|
|
1504 "Prints a list with processes in the buffer `View-process-buffer-name'.
|
|
|
1505 COMMAND-SWITCHES is a string with the command switches (ie: -aux).
|
|
|
1506 IF the optional argument REMOTE-HOST is given, then the command will
|
|
|
1507 be executed on the REMOTE-HOST. If an prefix arg is given, then the
|
|
|
1508 function asks for the name of the remote host.
|
|
|
1509 If USE-LAST-SORTER-AND-FILTER is t, then the last sorter and filter
|
|
|
1510 commands are used. Otherwise the sorter and filter from the list
|
|
|
1511 'View-process-sorter-and-filter' are used."
|
|
|
1512 (interactive
|
|
|
1513 (let ((View-process-stop-motion-help t))
|
|
|
1514 (list
|
|
|
1515 (read-string "Command switches: "
|
|
|
1516 (or View-process-status-last-command-switches
|
|
|
1517 (if (bufferp (get-buffer View-process-buffer-name))
|
|
|
1518 (cdr
|
|
|
1519 (assoc
|
|
|
1520 'View-process-status-last-command-switches
|
|
|
1521 (buffer-local-variables
|
|
|
1522 (get-buffer View-process-buffer-name)))))
|
|
|
1523 (if (string= "bsd" (View-process-bsd-or-system-v))
|
|
|
1524 View-process-status-command-switches-bsd
|
|
|
1525 View-process-status-command-switches-system-v))
|
|
|
1526 'View-process-status-history)
|
|
|
1527 (if current-prefix-arg
|
|
|
1528 (setq View-process-remote-host
|
|
|
1529 (read-string "Remote host name: "
|
|
|
1530 View-process-remote-host
|
|
|
1531 'View-process-remote-host-history))
|
|
|
1532 (setq View-process-remote-host nil)))))
|
|
|
1533 (View-process-save-old-window-configuration)
|
|
|
1534 (let ((buffer (get-buffer-create View-process-buffer-name))
|
|
|
1535 (position nil))
|
|
|
1536 ; (point-after-ps nil))
|
|
|
1537 (if (window-minibuffer-p (selected-window))
|
|
|
1538 (set-buffer buffer)
|
|
|
1539 (switch-to-buffer buffer))
|
|
|
1540
|
|
|
1541 ;; set switches for the next view process command
|
|
|
1542 (setq View-process-status-last-command-switches command-switches)
|
|
|
1543 (if (string= "bsd" (View-process-bsd-or-system-v))
|
|
|
1544 (setq View-process-status-command-switches-bsd command-switches)
|
|
|
1545 (setq View-process-status-command-switches-system-v command-switches))
|
|
|
1546
|
|
|
1547 (setq buffer-read-only nil)
|
|
|
1548 (if (not (= (point-min) (point-max)))
|
|
|
1549 (progn
|
|
|
1550 (setq position (View-process-save-position))
|
|
|
1551 ; (setq point-after-ps (point-min))
|
|
|
1552 ; (setq point-after-ps (point))
|
|
|
1553 (erase-buffer)))
|
|
|
1554 (View-process-insert-title-lines command-switches
|
|
|
1555 remote-host
|
|
|
1556 use-last-sorter-and-filter)
|
|
|
1557 (setq View-process-header-start (point))
|
|
|
1558 (if remote-host
|
|
|
1559 (call-process View-process-rsh-command
|
|
|
1560 nil
|
|
|
1561 t
|
|
|
1562 t
|
|
|
1563 remote-host
|
|
|
1564 (concat View-process-status-command
|
|
|
1565 " "
|
|
|
1566 command-switches))
|
|
|
1567 (call-process View-process-status-command
|
|
|
1568 nil
|
|
|
1569 t
|
|
|
1570 t
|
|
|
1571 command-switches))
|
|
|
1572 (View-process-search-header-line)
|
|
|
1573 (setq View-process-output-end (point-max))
|
|
|
1574 (View-process-replace-colons-with-blanks)
|
|
|
1575 (View-process-insert-blanks-at-line-start)
|
|
|
1576 (View-process-split-merged-fields View-process-insert-blank-alist)
|
|
|
1577 (View-process-init-internal-variables use-last-sorter-and-filter)
|
|
|
1578 (View-process-highlight-header-line)
|
|
|
1579 (goto-char View-process-output-start)
|
|
|
1580 (View-process-goto-position position)
|
|
|
1581 ; (goto-char (cond ((> point-after-ps (point-max)) (point-max))
|
|
|
1582 ; ((= point-after-ps (point-min)) View-process-output-start)
|
|
|
1583 ; ((< point-after-ps View-process-output-start)
|
|
|
1584 ; View-process-output-start)
|
|
|
1585 ; (t point-after-ps)))
|
|
|
1586 (setq buffer-read-only t)
|
|
|
1587 (let ((View-process-stop-motion-help t))
|
|
|
1588 ; (setq View-process-stop-motion-help t)
|
|
|
1589 (View-process-mode)
|
|
|
1590 ; (setq View-process-stop-motion-help nil)
|
|
|
1591 ; (View-process-redraw) ; only the first time (fixes an Emacs 19 bug)
|
|
|
1592 )
|
|
|
1593 ))
|
|
|
1594
|
|
|
1595 (defun View-process-status-update ()
|
|
|
1596 "Runs the `View-process-status' with the last switches
|
|
|
1597 and sorter and filter commands."
|
|
|
1598 (interactive)
|
|
|
1599 (if View-process-status-last-command-switches
|
|
|
1600 (View-process-status View-process-status-last-command-switches
|
|
|
1601 View-process-remote-host
|
|
|
1602 t)
|
|
|
1603 (error "ERROR: No view process buffer exists for update!")))
|
|
|
1604
|
|
|
1605 (defun view-processes (&optional remote-host)
|
|
|
1606 "Prints a list with processes in the buffer `View-process-buffer-name'.
|
|
|
1607 It calls the function `View-process-status' with default switches.
|
|
|
1608 As the default switches on BSD like systems the value of the variable
|
|
|
1609 `View-process-status-command-switches-bsd' is used.
|
|
|
1610 On System V like systems the value of the variable
|
|
|
1611 `View-process-status-command-switches-system-v' is used.
|
|
|
1612 IF the optional argument REMOTE-HOST is given, then the command will
|
|
|
1613 be executed on the REMOTE-HOST. If an prefix arg is given, then the
|
|
|
1614 function asks for the name of the remote host."
|
|
|
1615 (interactive
|
|
|
1616 (let ((View-process-stop-motion-help t))
|
|
|
1617 (list (if current-prefix-arg
|
|
|
1618 (setq View-process-remote-host
|
|
|
1619 (read-string "Remote host name: "
|
|
|
1620 View-process-remote-host
|
|
|
1621 'View-process-remote-host-history))
|
|
|
1622 (setq View-process-remote-host nil)))))
|
|
|
1623 (if (string= "bsd" (nth 2 (View-process-get-system-type)))
|
|
|
1624 (View-process-status View-process-status-command-switches-bsd
|
|
|
1625 View-process-remote-host)
|
|
|
1626 (View-process-status View-process-status-command-switches-system-v
|
|
|
1627 remote-host)))
|
|
|
1628
|
|
|
1629 ;;; itimer functions (to repeat the ps output)
|
|
|
1630
|
|
|
1631 (defun View-process-status-itimer-function ()
|
|
|
1632 "Itimer function for updating the ps output."
|
|
|
1633 (save-excursion
|
|
|
1634 (save-window-excursion
|
|
|
1635 (View-process-status-update)))
|
|
|
1636 ;;(View-process-start-itimer)
|
|
|
1637 )
|
|
|
1638
|
|
|
1639
|
|
|
1640 ;;; help functions
|
|
|
1641
|
|
|
1642 (defun View-process-show-pid-and-command-or-field-name ()
|
|
|
1643 "Displays the pid and the command of the current line or the field name.
|
|
|
1644 If the point is at a blank, then the pid and the command of the current
|
|
|
1645 line are displayed. Otherwise the name of the field and its description
|
|
|
1646 are displayed."
|
|
|
1647 (interactive)
|
|
|
1648 (if (looking-at " ")
|
|
|
1649 (View-process-show-pid-and-command)
|
|
|
1650 (View-process-which-field-name)))
|
|
|
1651
|
|
|
1652 (defun View-process-show-pid-and-command ()
|
|
|
1653 "Displays the pid and the command of the current line.
|
|
|
1654 It assumes, that the command is displayed at the end of the line."
|
|
|
1655 (interactive)
|
|
|
1656 (if (>= (point) View-process-output-start)
|
|
|
1657 (message "PID= %s, %s"
|
|
|
1658 (View-process-get-pid-from-current-line)
|
|
|
1659 (View-process-get-field-value-from-current-line
|
|
|
1660 View-process-max-fields
|
|
|
1661 View-process-max-fields))))
|
|
|
1662
|
|
|
1663 (defun View-process-show-field-names ()
|
|
|
1664 "Displays the name(s) of the ps output field(s).
|
|
|
1665 If the point is at a blank, then the header line with all field names
|
|
|
1666 is displayed. Otherwise only the name of the field at the point is
|
|
|
1667 displayed."
|
|
|
1668 (interactive)
|
|
|
1669 (if (looking-at " ")
|
|
|
1670 (View-process-show-header-line)
|
|
|
1671 (View-process-which-field-name)))
|
|
|
1672
|
|
|
1673 (defun View-process-show-header-line ()
|
|
|
1674 "Displays the header line in the buffer at the current line."
|
|
|
1675 (interactive)
|
|
|
1676 (save-window-excursion
|
|
|
1677 (let ((header-line (save-restriction
|
|
|
1678 (widen)
|
|
|
1679 (concat
|
|
|
1680 (buffer-substring View-process-header-start
|
|
|
1681 View-process-header-end)
|
|
|
1682 "\n"))))
|
|
|
1683 (momentary-string-display header-line
|
|
|
1684 (View-process-return-beginning-of-line)))))
|
|
|
1685
|
|
|
1686 (defun View-process-which-field-name ()
|
|
|
1687 "Displays the name of the field under the point in the echo area."
|
|
|
1688 (interactive)
|
|
|
1689 (if (>= (point) View-process-header-start)
|
|
|
1690 (let ((field-name (View-process-translate-field-position-to-name
|
|
|
1691 (View-process-current-field-number))))
|
|
|
1692 (message
|
|
|
1693 (View-process-replace-in-string
|
|
|
1694 "%"
|
|
|
1695 "%%"
|
|
|
1696 (concat field-name
|
|
|
1697 ": "
|
|
|
1698 (View-process-get-field-name-description field-name)))))))
|
|
|
1699
|
|
|
1700 (defun View-process-get-field-name-description (field-name)
|
|
|
1701 "Returns a string with a desciption of the ps output field FIELD-NAME."
|
|
|
1702 (let ((description
|
|
|
1703 (or (car (cdr (assoc field-name
|
|
|
1704 View-process-field-name-descriptions)))
|
|
|
1705 (car (cdr (assoc field-name
|
|
|
1706 View-process-field-name-descriptions-general))))
|
|
|
1707 ))
|
|
|
1708 (if (stringp description)
|
|
|
1709 description
|
|
|
1710 (concat (car description)
|
|
|
1711 (View-process-get-value-description
|
|
|
1712 (View-process-get-field-value-from-current-line
|
|
|
1713 (View-process-translate-field-name-to-position field-name)
|
|
|
1714 View-process-max-fields)
|
|
|
1715 (cdr description))))))
|
|
|
1716
|
|
|
1717 (defun View-process-get-value-description (values value-descriptions)
|
|
|
1718 "Returns a string with the description of the VALUES.
|
|
|
1719 VALUE-DESCRIPTIONS is an alist with the possible values and its
|
|
|
1720 descriptions."
|
|
|
1721 (cond ((string= values "") "")
|
|
|
1722 ((or (eq (aref values 0) ?_) (eq (aref values 0) ? ))
|
|
|
1723 (View-process-get-value-description (substring values 1)
|
|
|
1724 value-descriptions))
|
|
|
1725 (t (concat
|
|
|
1726 (car
|
|
|
1727 (cdr
|
|
|
1728 (assoc
|
|
|
1729 (substring values 0 (string-match "[ _]" values))
|
|
|
1730 value-descriptions)))
|
|
|
1731 (if (string-match "[ _]" values)
|
|
|
1732 (View-process-get-value-description
|
|
|
1733 (substring values (string-match "[ _]" values))
|
|
|
1734 value-descriptions)
|
|
|
1735 "")))))
|
|
|
1736
|
|
|
1737
|
|
|
1738 ;;; sort functions
|
|
|
1739
|
|
|
1740 (defun View-process-current-field-number ()
|
|
|
1741 "Returns the field number of the point.
|
|
|
1742 The functions fails with an error message, if the character under
|
|
|
1743 the point is a blank."
|
|
|
1744 (View-process-replaces-blanks-in-fields-if-necessary)
|
|
|
1745 (save-excursion
|
|
|
1746 (if (looking-at " ")
|
|
|
1747 (error "Point is on a blank and not in a field!")
|
|
|
1748 (if (and (eq (point) (point-max))
|
|
|
1749 (eq (current-column) 0))
|
|
|
1750 (error "Point is not in a field!")
|
|
|
1751 (let ((field-point (point))
|
|
|
1752 (i 0))
|
|
|
1753 (beginning-of-line)
|
|
|
1754 (skip-chars-forward " ")
|
|
|
1755 (while (>= field-point (point))
|
|
|
1756 (setq i (1+ i))
|
|
|
1757 (skip-chars-forward "^ ")
|
|
|
1758 (skip-chars-forward " "))
|
|
|
1759 i)))))
|
|
|
1760
|
|
|
1761 (defun View-process-sort-fields-in-region (field
|
|
|
1762 beg
|
|
|
1763 end
|
|
|
1764 &optional sort-function)
|
|
|
1765 "Sort lines in region by the ARGth field of each line.
|
|
|
1766 Fields are separated by whitespace and numbered from 1 up.
|
|
|
1767 With a negative arg, sorts by the ARGth field counted from the right.
|
|
|
1768 BEG and END specify region to sort.
|
|
|
1769 If the optional SORT-FUNCTION is nil, then the region is at first
|
|
|
1770 sorted with the function `sort-fields' and then with the function
|
|
|
1771 `sort-float-fields'. Otherwise a sort function like `sort-fields'
|
|
|
1772 must be specified."
|
|
|
1773 (let ((position (View-process-save-position))
|
|
|
1774 ; (point (point)) ;; that's, because save-excursion
|
|
|
1775 ; (column (current-column)) ;; doesn't work :-(
|
|
|
1776 (field-no (if (< field View-process-max-fields)
|
|
|
1777 field
|
|
|
1778 View-process-max-fields)))
|
|
|
1779 (if sort-function
|
|
|
1780 (eval (list sort-function field-no beg end))
|
|
|
1781 (sort-fields field-no beg end)
|
|
|
1782 (sort-float-fields field-no beg end))
|
|
|
1783 (View-process-goto-position position)))
|
|
|
1784 ; (goto-char point)
|
|
|
1785 ; (goto-char (+ point (- column (current-column))))))
|
|
|
1786
|
|
|
1787 (defun View-process-remove-sorter (sorter alist)
|
|
|
1788 "Removes the SORTER entry from the ALIST."
|
|
|
1789 (cond ((not alist) nil)
|
|
|
1790 ((eq sorter (car (car alist))) (cdr alist))
|
|
|
1791 (t (cons (car alist)
|
|
|
1792 (View-process-remove-sorter sorter (cdr alist))))))
|
|
|
1793
|
|
|
1794 (defun View-process-sort-output-by-field (field-name
|
|
|
1795 &optional dont-remember)
|
|
|
1796 "Sort the ps output by the field FIELD-NAME.
|
|
|
1797 If DONT-REMEMBER is t, then the filter command isn't inserted
|
|
|
1798 in the `View-process-actual-sorter-and-filter' list."
|
|
|
1799 (interactive
|
|
|
1800 (let ((View-process-stop-motion-help t))
|
|
|
1801 (list
|
|
|
1802 (completing-read "Field Name for sorting: "
|
|
|
1803 View-process-field-names
|
|
|
1804 nil
|
|
|
1805 t
|
|
|
1806 (car View-process-field-name-history)
|
|
|
1807 View-process-field-name-history))))
|
|
|
1808 (setq buffer-read-only nil)
|
|
|
1809 (View-process-sort-fields-in-region
|
|
|
1810 (View-process-translate-field-name-to-position field-name)
|
|
|
1811 View-process-output-start
|
|
|
1812 View-process-output-end)
|
|
|
1813 (setq buffer-read-only t)
|
|
|
1814 (if (not dont-remember)
|
|
|
1815 (setq View-process-actual-sorter-and-filter
|
|
|
1816 (append (View-process-remove-sorter
|
|
|
1817 'reverse
|
|
|
1818 (View-process-remove-sorter
|
|
|
1819 'sort
|
|
|
1820 View-process-actual-sorter-and-filter))
|
|
|
1821 (list (list 'sort field-name))))))
|
|
|
1822
|
|
|
1823 (defun View-process-sort-by-current-field-g ()
|
|
|
1824 "Sort the ps output by the field under the point.
|
|
|
1825 It is a generic interface to `View-process-sort-region-by-current-field'
|
|
|
1826 and `View-process-sort-output-by-current-field'.The first will be called
|
|
|
1827 if a region is active and the other one if not.
|
|
|
1828 With a prefix arg, it uses the NTH field instead of the current one."
|
|
|
1829 (interactive)
|
|
|
1830 (if (View-process-region-active-p)
|
|
|
1831 (call-interactively 'View-process-sort-region-by-current-field)
|
|
|
1832 (call-interactively 'View-process-sort-output-by-current-field)))
|
|
|
1833
|
|
|
1834 (defun View-process-sort-output-by-current-field (&optional nth dont-remember)
|
|
|
1835 "Sort the whole ps output by the field under the point.
|
|
|
1836 With a prefix arg, it uses the NTH field instead of the current one.
|
|
|
1837 If DONT-REMEMBER is t, then the filter command isn't inserted
|
|
|
1838 in the `View-process-actual-sorter-and-filter' list."
|
|
|
1839 (interactive "P")
|
|
|
1840 (let ((field-number (if nth
|
|
|
1841 (if (and (>= nth 1) (<= nth View-process-max-fields))
|
|
|
1842 nth
|
|
|
1843 (error "ERROR: Wrong field number!"))
|
|
|
1844 (View-process-current-field-number))))
|
|
|
1845 (setq buffer-read-only nil)
|
|
|
1846 (View-process-sort-fields-in-region field-number
|
|
|
1847 View-process-output-start
|
|
|
1848 View-process-output-end)
|
|
|
1849 (setq buffer-read-only t)
|
|
|
1850 (if (not dont-remember)
|
|
|
1851 (setq View-process-actual-sorter-and-filter
|
|
|
1852 (append (View-process-remove-sorter
|
|
|
1853 'reverse
|
|
|
1854 (View-process-remove-sorter
|
|
|
1855 'sort
|
|
|
1856 View-process-actual-sorter-and-filter))
|
|
|
1857 (list
|
|
|
1858 (list 'sort
|
|
|
1859 (View-process-translate-field-position-to-name
|
|
|
1860 field-number))))))))
|
|
|
1861
|
|
|
1862 (defun View-process-sort-region-by-current-field (&optional nth)
|
|
|
1863 "Sort the region by the field under the point.
|
|
|
1864 With a prefix arg, it uses the NTH field instead of the current one."
|
|
|
1865 (interactive "P")
|
|
|
1866 (let ((field-number (if nth
|
|
|
1867 (if (and (>= nth 1) (<= nth View-process-max-fields))
|
|
|
1868 nth
|
|
|
1869 (error "ERROR: Wrong field number!"))
|
|
|
1870 (View-process-current-field-number))))
|
|
|
1871 (setq buffer-read-only nil)
|
|
|
1872 (View-process-sort-fields-in-region
|
|
|
1873 field-number
|
|
|
1874 (save-excursion
|
|
|
1875 (goto-char (region-beginning))
|
|
|
1876 (View-process-return-beginning-of-line))
|
|
|
1877 (save-excursion
|
|
|
1878 (goto-char (region-end))
|
|
|
1879 (View-process-return-end-of-line)))
|
|
|
1880 (setq buffer-read-only t)))
|
|
|
1881
|
|
|
1882 (defun View-process-reverse-output (&optional dont-remember)
|
|
|
1883 "Reverses the whole output lines.
|
|
|
1884 If DONT-REMEMBER is t, then the filter command isn't inserted
|
|
|
1885 in the `View-process-actual-sorter-and-filter' list."
|
|
|
1886 (interactive)
|
|
|
1887 (setq buffer-read-only nil)
|
|
|
1888 (let ((position (View-process-save-position)))
|
|
|
1889 ; (line (count-lines (point-min) (point)))
|
|
|
1890 ; (column (current-column)))
|
|
|
1891 (reverse-region View-process-output-start View-process-output-end)
|
|
|
1892 (View-process-goto-position position))
|
|
|
1893 ; (goto-line line)
|
|
|
1894 ; (beginning-of-line)
|
|
|
1895 ; (forward-char column))
|
|
|
1896 (setq buffer-read-only t)
|
|
|
1897 (if (not dont-remember)
|
|
|
1898 (setq View-process-actual-sorter-and-filter
|
|
|
1899 (if (assq 'reverse View-process-actual-sorter-and-filter)
|
|
|
1900 (View-process-remove-sorter
|
|
|
1901 'reverse
|
|
|
1902 View-process-actual-sorter-and-filter)
|
|
|
1903 (append View-process-actual-sorter-and-filter
|
|
|
1904 (list (list 'reverse)))))))
|
|
|
1905
|
|
|
1906 (defun View-process-reverse-region ()
|
|
|
1907 "Reverses the output lines in the region."
|
|
|
1908 (interactive)
|
|
|
1909 (setq buffer-read-only nil)
|
|
|
1910 (let ((region-beginning (if (< (region-beginning) (region-end))
|
|
|
1911 (region-beginning)
|
|
|
1912 (region-end)))
|
|
|
1913 (region-end (if (> (region-end) (region-beginning))
|
|
|
1914 (region-end)
|
|
|
1915 (region-beginning)))
|
|
|
1916 (position (View-process-save-position)))
|
|
|
1917 ; (line (count-lines (point-min) (point)))
|
|
|
1918 ; (column (current-column)))
|
|
|
1919 (reverse-region (if (< region-beginning View-process-output-start)
|
|
|
1920 View-process-output-start
|
|
|
1921 (goto-char region-beginning)
|
|
|
1922 (View-process-return-beginning-of-line))
|
|
|
1923 (if (> region-end View-process-output-end)
|
|
|
1924 View-process-output-end
|
|
|
1925 (goto-char region-end)
|
|
|
1926 (View-process-return-end-of-line)))
|
|
|
1927 (View-process-goto-position position))
|
|
|
1928 ; (goto-line line)
|
|
|
1929 ; (beginning-of-line)
|
|
|
1930 ; (forward-char column))
|
|
|
1931 (setq buffer-read-only t))
|
|
|
1932
|
|
|
1933 (defun View-process-reverse-g ()
|
|
|
1934 "Reverses the output lines.
|
|
|
1935 It is a generic interface to `View-process-reverse-region'
|
|
|
1936 and `View-process-reverse-output'. The first will be called
|
|
|
1937 if a region is active and the other one if not."
|
|
|
1938 (interactive)
|
|
|
1939 (if (View-process-region-active-p)
|
|
|
1940 (call-interactively 'View-process-reverse-region)
|
|
|
1941 (call-interactively 'View-process-reverse-output)))
|
|
|
1942
|
|
|
1943 ;;; filter functions
|
|
|
1944
|
|
|
1945 (defun View-process-delete-region (start end)
|
|
|
1946 "Stores deleted lines in `View-process-deleted-lines'."
|
|
|
1947 (setq View-process-deleted-lines
|
|
|
1948 (cons (buffer-substring start end)
|
|
|
1949 View-process-deleted-lines))
|
|
|
1950 (delete-region start end))
|
|
|
1951
|
|
|
1952 (defun View-process-remove-all-filter-and-sorter ()
|
|
|
1953 "Undeletes all filtered lines from `View-process-deleted-lines'.
|
|
|
1954 It removes also all filter and sorter from the list
|
|
|
1955 `View-process-actual-sorter-and-filter'."
|
|
|
1956 (interactive)
|
|
|
1957 (let ((buffer-read-only))
|
|
|
1958 (goto-char View-process-output-end)
|
|
|
1959 (mapcar '(lambda (line)
|
|
|
1960 (insert line))
|
|
|
1961 View-process-deleted-lines)
|
|
|
1962 (setq View-process-output-end (point))
|
|
|
1963 (setq View-process-actual-sorter-and-filter nil)
|
|
|
1964 (goto-char View-process-output-start)))
|
|
|
1965
|
|
|
1966 (defun View-process-filter-fields-in-region (regexp
|
|
|
1967 field-no
|
|
|
1968 beg
|
|
|
1969 end
|
|
|
1970 &optional exclude)
|
|
|
1971 "Filters a region with a REGEXP in the field FIELD-NO.
|
|
|
1972 The region start is at BEG and the end at END. If FIELD-NO
|
|
|
1973 is nil, then the whole line is used. All lines which passes
|
|
|
1974 not the filter are deleted in the buffer, if EXCLUDE is nil.
|
|
|
1975 Otherwise only these lines are not deleted."
|
|
|
1976 (save-restriction
|
|
|
1977 (widen)
|
|
|
1978 (let ((region-start (if (< beg end) beg end))
|
|
|
1979 (region-end (if (> beg end) beg end)))
|
|
|
1980 (if (< region-start View-process-output-start)
|
|
|
1981 (setq region-start View-process-output-start))
|
|
|
1982 (goto-char region-end)
|
|
|
1983 (if field-no
|
|
|
1984 (while (>= (point) region-start)
|
|
|
1985 (if (string-match regexp
|
|
|
1986 (View-process-get-field-value-from-current-line
|
|
|
1987 field-no
|
|
|
1988 View-process-max-fields))
|
|
|
1989 (if exclude
|
|
|
1990 (View-process-delete-region
|
|
|
1991 (1- (View-process-return-beginning-of-line))
|
|
|
1992 (View-process-return-end-of-line))
|
|
|
1993 (forward-line -1))
|
|
|
1994 (if exclude
|
|
|
1995 (forward-line -1)
|
|
|
1996 (View-process-delete-region
|
|
|
1997 (1- (View-process-return-beginning-of-line))
|
|
|
1998 (View-process-return-end-of-line)))
|
|
|
1999 ))
|
|
|
2000 (beginning-of-line)
|
|
|
2001 (while (>= (point) region-start)
|
|
|
2002 (if (search-forward-regexp regexp
|
|
|
2003 (View-process-return-end-of-line) t)
|
|
|
2004 (if exclude
|
|
|
2005 (progn
|
|
|
2006 (View-process-delete-region
|
|
|
2007 (1- (View-process-return-beginning-of-line))
|
|
|
2008 (View-process-return-end-of-line))
|
|
|
2009 (beginning-of-line))
|
|
|
2010 (forward-line -1))
|
|
|
2011 (if exclude
|
|
|
2012 (forward-line -1)
|
|
|
2013 (View-process-delete-region
|
|
|
2014 (1- (View-process-return-beginning-of-line))
|
|
|
2015 (View-process-return-end-of-line))
|
|
|
2016 (beginning-of-line))
|
|
|
2017 )))
|
|
|
2018 (goto-char region-start))
|
|
|
2019 (setq View-process-output-end (point-max))
|
|
|
2020 (if (> View-process-output-start View-process-output-end)
|
|
|
2021 (progn
|
|
|
2022 (newline)
|
|
|
2023 (setq View-process-output-end View-process-output-start)))))
|
|
|
2024
|
|
|
2025 (defun View-process-filter-output-by-field (field-name
|
|
|
2026 regexp
|
|
|
2027 &optional exclude
|
|
|
2028 dont-remember)
|
|
|
2029 "Filter the whole output by the field FIELD-NAME with REGEXP.
|
|
|
2030 The matching lines are deleted, if EXCLUDE is t. The non matching
|
|
|
2031 lines are deleted, if EXCLUDE is nil. If you call this function
|
|
|
2032 interactive, then you can give a prefix arg to set EXCLUDE to non nil.
|
|
|
2033 If DONT-REMEMBER is t, then the filter command isn't inserted
|
|
|
2034 in the `View-process-actual-sorter-and-filter' list."
|
|
|
2035 (interactive
|
|
|
2036 (let ((View-process-stop-motion-help t))
|
|
|
2037 (list
|
|
|
2038 (completing-read "Field Name for filtering: "
|
|
|
2039 View-process-field-names
|
|
|
2040 nil
|
|
|
2041 t
|
|
|
2042 (car View-process-field-name-history)
|
|
|
2043 View-process-field-name-history)
|
|
|
2044 (read-string "Regexp for filtering the output in the field: "
|
|
|
2045 (car View-process-filter-history)
|
|
|
2046 View-process-filter-history)
|
|
|
2047 current-prefix-arg
|
|
|
2048 )))
|
|
|
2049 (setq buffer-read-only nil)
|
|
|
2050 (View-process-filter-fields-in-region
|
|
|
2051 regexp
|
|
|
2052 (View-process-translate-field-name-to-position field-name)
|
|
|
2053 View-process-output-start
|
|
|
2054 View-process-output-end
|
|
|
2055 exclude)
|
|
|
2056 (setq buffer-read-only t)
|
|
|
2057 (if (not dont-remember)
|
|
|
2058 (setq View-process-actual-sorter-and-filter
|
|
|
2059 (append View-process-actual-sorter-and-filter
|
|
|
2060 (list (list (if exclude 'exclude-filter 'filter)
|
|
|
2061 field-name
|
|
|
2062 regexp))))))
|
|
|
2063
|
|
|
2064 (defun View-process-filter-output-by-current-field (regexp
|
|
|
2065 &optional exclude
|
|
|
2066 dont-remember)
|
|
|
2067 "Filter the whole output by the field under the point with REGEXP.
|
|
|
2068 The matching lines are deleted, if EXCLUDE is t. The non matching
|
|
|
2069 lines are deleted, if EXCLUDE is nil. If you call this function
|
|
|
2070 interactive, then you can give a prefix arg to set EXCLUDE to non nil.
|
|
|
2071 If DONT-REMEMBER is t, then the filter command isn't inserted
|
|
|
2072 in the `View-process-actual-sorter-and-filter' list."
|
|
|
2073 ; (interactive "sRegexp for filtering the output in the current field: \nP")
|
|
|
2074 (interactive
|
|
|
2075 (let* ((View-process-stop-motion-help t)
|
|
|
2076 (regexp (read-string
|
|
|
2077 "sRegexp for filtering the output in the current field: "))
|
|
|
2078 (exclude current-prefix-arg))
|
|
|
2079 (list regexp exclude)))
|
|
|
2080 (let ((current-field-number (View-process-current-field-number)))
|
|
|
2081 (setq buffer-read-only nil)
|
|
|
2082 (View-process-filter-fields-in-region regexp
|
|
|
2083 current-field-number
|
|
|
2084 View-process-output-start
|
|
|
2085 View-process-output-end
|
|
|
2086 exclude)
|
|
|
2087 (setq buffer-read-only t)
|
|
|
2088 (if (not dont-remember)
|
|
|
2089 (setq View-process-actual-sorter-and-filter
|
|
|
2090 (append View-process-actual-sorter-and-filter
|
|
|
2091 (list
|
|
|
2092 (list (if exclude 'exclude-filter 'filter)
|
|
|
2093 (View-process-translate-field-position-to-name
|
|
|
2094 current-field-number)
|
|
|
2095 regexp)))))))
|
|
|
2096
|
|
|
2097 (defun View-process-filter-region-by-current-field (regexp &optional exclude)
|
|
|
2098 "Filter the region by the field under the point with REGEXP.
|
|
|
2099 The matching lines are deleted, if EXCLUDE is t. The non matching
|
|
|
2100 lines are deleted, if EXCLUDE is nil. If you call this function
|
|
|
2101 interactive, then you can give a prefix arg to set EXCLUDE to non nil."
|
|
|
2102 ; (interactive "sRegexp for filtering the region in the current field: \nP")
|
|
|
2103 (interactive
|
|
|
2104 (let* ((View-process-stop-motion-help t)
|
|
|
2105 (regexp (read-string
|
|
|
2106 "sRegexp for filtering the region in the current field: "))
|
|
|
2107 (exclude current-prefix-arg))
|
|
|
2108 (list regexp exclude)))
|
|
|
2109 (setq buffer-read-only nil)
|
|
|
2110 (View-process-filter-fields-in-region
|
|
|
2111 regexp
|
|
|
2112 (View-process-current-field-number)
|
|
|
2113 (save-excursion
|
|
|
2114 (goto-char (region-beginning))
|
|
|
2115 (View-process-return-beginning-of-line))
|
|
|
2116 (save-excursion
|
|
|
2117 (goto-char (region-end))
|
|
|
2118 (View-process-return-end-of-line))
|
|
|
2119 exclude)
|
|
|
2120 (setq buffer-read-only t))
|
|
|
2121
|
|
|
2122 (defun View-process-filter-by-current-field-g (&optional exclude)
|
|
|
2123 "Filter the whole output by the field under the point with an Regexp.
|
|
|
2124 It is a generic interface to `View-process-filter-region-by-current-field'
|
|
|
2125 and `View-process-filter-output-by-current-field'. The first will be called
|
|
|
2126 if a region is active and the other one if not.
|
|
|
2127 The matching lines are deleted, if EXCLUDE is t. The non matching
|
|
|
2128 lines are deleted, if EXCLUDE is nil. If you call this function
|
|
|
2129 interactive, then you can give a prefix arg to set EXCLUDE to non nil."
|
|
|
2130 (interactive "P")
|
|
|
2131 (setq prefix-arg current-prefix-arg)
|
|
|
2132 (if (View-process-region-active-p)
|
|
|
2133 (call-interactively 'View-process-filter-region-by-current-field)
|
|
|
2134 (call-interactively 'View-process-filter-output-by-current-field)))
|
|
|
2135
|
|
|
2136 (defun View-process-filter-output (regexp &optional exclude dont-remember)
|
|
|
2137 "Filter the whole output with REGEXP.
|
|
|
2138 The matching lines are deleted, if EXCLUDE is t. The non matching
|
|
|
2139 lines are deleted, if EXCLUDE is nil. If you call this function
|
|
|
2140 interactive, then you can give a prefix arg to set EXCLUDE to non nil.
|
|
|
2141 If DONT-REMEMBER is t, then the filter command isn't inserted
|
|
|
2142 in the `View-process-actual-sorter-and-filter' list."
|
|
|
2143 ; (interactive "sRegexp for filtering the output: \nP")
|
|
|
2144 (interactive
|
|
|
2145 (let* ((View-process-stop-motion-help t)
|
|
|
2146 (regexp (read-string
|
|
|
2147 "sRegexp for filtering the output: "))
|
|
|
2148 (exclude current-prefix-arg))
|
|
|
2149 (list regexp exclude)))
|
|
|
2150 (setq buffer-read-only nil)
|
|
|
2151 (View-process-filter-fields-in-region regexp
|
|
|
2152 nil
|
|
|
2153 View-process-output-start
|
|
|
2154 View-process-output-end
|
|
|
2155 exclude)
|
|
|
2156 (setq buffer-read-only t)
|
|
|
2157 (if (not dont-remember)
|
|
|
2158 (setq View-process-actual-sorter-and-filter
|
|
|
2159 (append View-process-actual-sorter-and-filter
|
|
|
2160 (list (list (if exclude 'exclude-grep 'grep)
|
|
|
2161 regexp))))))
|
|
|
2162
|
|
|
2163 (defun View-process-filter-region (regexp &optional exclude)
|
|
|
2164 "Filter the region with REGEXP.
|
|
|
2165 The matching lines are deleted, if EXCLUDE is t. The non matching
|
|
|
2166 lines are deleted, if EXCLUDE is nil. If you call this function
|
|
|
2167 interactive, then you can give a prefix arg to set EXCLUDE to non nil."
|
|
|
2168 ; (interactive "sRegexp for filtering the region: \nP")
|
|
|
2169 (interactive
|
|
|
2170 (let* ((View-process-stop-motion-help t)
|
|
|
2171 (regexp (read-string
|
|
|
2172 "sRegexp for filtering the region: "))
|
|
|
2173 (exclude current-prefix-arg))
|
|
|
2174 (list regexp exclude)))
|
|
|
2175 (setq buffer-read-only nil)
|
|
|
2176 (View-process-filter-fields-in-region
|
|
|
2177 regexp
|
|
|
2178 nil
|
|
|
2179 (save-excursion
|
|
|
2180 (goto-char (region-beginning))
|
|
|
2181 (View-process-return-beginning-of-line))
|
|
|
2182 (save-excursion
|
|
|
2183 (goto-char (region-end))
|
|
|
2184 (View-process-return-end-of-line))
|
|
|
2185 exclude)
|
|
|
2186 (setq buffer-read-only t))
|
|
|
2187
|
|
|
2188 (defun View-process-filter-g (&optional exclude)
|
|
|
2189 "Filters the output by the field under the point with an Regexp.
|
|
|
2190 It is a generic interface to `View-process-filter-region'
|
|
|
2191 and `View-process-filter-output'. The first will be called
|
|
|
2192 if a region is active and the other one if not.
|
|
|
2193 The matching lines are deleted, if EXCLUDE is t. The non matching
|
|
|
2194 lines are deleted, if EXCLUDE is nil. If you call this function
|
|
|
2195 interactive, then you can give a prefix arg to set EXCLUDE to non nil."
|
|
|
2196 (interactive "P")
|
|
|
2197 (setq prefix-arg current-prefix-arg)
|
|
|
2198 (if (View-process-region-active-p)
|
|
|
2199 (call-interactively 'View-process-filter-region)
|
|
|
2200 (call-interactively 'View-process-filter-output)))
|
|
|
2201
|
|
|
2202
|
|
|
2203 ;;; call sorter, filter or grep after running ps
|
|
|
2204
|
|
|
2205 (defun View-process-call-sorter-and-filter (sorter-and-filter-list)
|
|
|
2206 "Call sorter, filter or grep after running ps.
|
|
|
2207 The sorter, filter or grep commands and its parameters are called
|
|
|
2208 from SORTER-AND-FILTER-LIST."
|
|
|
2209 (cond ((not sorter-and-filter-list) t)
|
|
|
2210 ((eq 'grep (car (car sorter-and-filter-list)))
|
|
|
2211 (View-process-filter-output (car (cdr (car sorter-and-filter-list)))
|
|
|
2212 nil
|
|
|
2213 t)
|
|
|
2214 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
|
|
|
2215 ((eq 'exclude-grep (car (car sorter-and-filter-list)))
|
|
|
2216 (View-process-filter-output (car (cdr (car sorter-and-filter-list)))
|
|
|
2217 t
|
|
|
2218 t)
|
|
|
2219 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
|
|
|
2220 ((eq 'sort (car (car sorter-and-filter-list)))
|
|
|
2221 (if (assoc (car (cdr (car sorter-and-filter-list)))
|
|
|
2222 View-process-field-names)
|
|
|
2223 (View-process-sort-output-by-field
|
|
|
2224 (car (cdr (car sorter-and-filter-list)))
|
|
|
2225 t))
|
|
|
2226 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
|
|
|
2227 ((eq 'filter (car (car sorter-and-filter-list)))
|
|
|
2228 (if (assoc (car (cdr (car sorter-and-filter-list)))
|
|
|
2229 View-process-field-names)
|
|
|
2230 (View-process-filter-output-by-field
|
|
|
2231 (car (cdr (car sorter-and-filter-list)))
|
|
|
2232 (car (cdr (cdr (car sorter-and-filter-list))))
|
|
|
2233 nil
|
|
|
2234 t))
|
|
|
2235 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
|
|
|
2236 ((eq 'exclude-filter (car (car sorter-and-filter-list)))
|
|
|
2237 (if (assoc (car (cdr (car sorter-and-filter-list)))
|
|
|
2238 View-process-field-names)
|
|
|
2239 (View-process-filter-output-by-field
|
|
|
2240 (car (cdr (car sorter-and-filter-list)))
|
|
|
2241 (car (cdr (cdr (car sorter-and-filter-list))))
|
|
|
2242 t
|
|
|
2243 t))
|
|
|
2244 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
|
|
|
2245 ((eq 'reverse (car (car sorter-and-filter-list)))
|
|
|
2246 (View-process-reverse-output t)
|
|
|
2247 (View-process-call-sorter-and-filter (cdr sorter-and-filter-list)))
|
|
|
2248 (t (error "Filter/Sorter command not implemented!"))))
|
|
|
2249
|
|
|
2250
|
|
|
2251 ;;; Child processes
|
|
|
2252
|
|
|
2253 (defun View-process-get-child-process-list-1 (pid pid-ppid-alist)
|
|
|
2254 "Internal function of `View-process-get-child-process-list'."
|
|
|
2255 (cond ((car pid-ppid-alist)
|
|
|
2256 (if (not (string= pid (cdr (car pid-ppid-alist))))
|
|
|
2257 (View-process-get-child-process-list-1 pid (cdr pid-ppid-alist))
|
|
|
2258 (cons (car (car pid-ppid-alist))
|
|
|
2259 (View-process-get-child-process-list-1 pid
|
|
|
2260 (cdr pid-ppid-alist))
|
|
|
2261 )))))
|
|
|
2262
|
|
|
2263 (defun View-process-get-child-process-list (pid pid-ppid-alist)
|
|
|
2264 "Returns a list with all direct childs of the processes with the PID.
|
|
|
2265 The list PID-PPID-ALIST is an alist with the pid's as car's
|
|
|
2266 and ppid's as cdr's.
|
|
|
2267 Example list: (\"0\" \"10\" \"20\")
|
|
|
2268 With \"0\" eq PID as the parent of the direct childs \"10\" and \"20\"."
|
|
|
2269 (cons pid (View-process-get-child-process-list-1 pid pid-ppid-alist)))
|
|
|
2270
|
|
|
2271 (defun View-process-get-child-process-tree (pid)
|
|
|
2272 "Returns a list with all childs and subchilds of the processes with the PID.
|
|
|
2273 Example list: (\"0\" (\"10\") (\"20\" (\"30\" \"40\")))
|
|
|
2274 With \"0\" eq PID as the parent of the direct childs \"10\" and \"20\"
|
|
|
2275 and with \"20\" as the parent of the direct childs \"30\" and \"40\"."
|
|
|
2276 (cons pid
|
|
|
2277 (mapcar 'View-process-get-child-process-tree
|
|
|
2278 (cdr (View-process-get-child-process-list
|
|
|
2279 pid
|
|
|
2280 (save-excursion
|
|
|
2281 (View-process-get-pid-ppid-list-from-region
|
|
|
2282 View-process-output-start
|
|
|
2283 View-process-output-end)))))))
|
|
|
2284
|
|
|
2285 ;(defun View-process-highlight-process-tree (process-tree)
|
|
|
2286 ; "Highlights all processes in the list process-tree."
|
|
|
2287 ; (cond ((not process-tree))
|
|
|
2288 ; ((listp (car process-tree))
|
|
|
2289 ; (View-process-highlight-process-tree (car process-tree))
|
|
|
2290 ; (View-process-highlight-process-tree (cdr process-tree)))
|
|
|
2291 ; ((stringp (car process-tree))
|
|
|
2292 ; (View-process-highlight-line-with-pid (car process-tree)
|
|
|
2293 ; 'View-process-child-line-face
|
|
|
2294 ; View-process-child-line-mark)
|
|
|
2295 ; (View-process-highlight-process-tree (cdr process-tree)))
|
|
|
2296 ; (t (error "Bug in 'View-process-highlight-process-tree' !"))))
|
|
|
2297
|
|
|
2298 ;(defun View-process-highlight-recursive-all-childs (pid)
|
|
|
2299 ; "Highlights all childs of the process with the PID."
|
|
|
2300 ; (interactive "sParent PID: ")
|
|
|
2301 ; (if (not
|
|
|
2302 ; (View-process-field-name-exists-p View-process-ppid-field-name))
|
|
|
2303 ; (error "ERROR: No field `%s' in the output. Try `M-x ps -j' to get it."
|
|
|
2304 ; View-process-ppid-field-name)
|
|
|
2305 ; (View-process-highlight-line-with-pid pid
|
|
|
2306 ; 'View-process-parent-line-face
|
|
|
2307 ; View-process-parent-line-mark)
|
|
|
2308 ; (View-process-highlight-process-tree
|
|
|
2309 ; (cdr (View-process-get-child-process-tree pid)))))
|
|
|
2310
|
|
|
2311 ;(defun View-process-highlight-recursive-all-childs-in-line ()
|
|
|
2312 ; "Highlights all the child processes of the process in the current line."
|
|
|
2313 ; (interactive)
|
|
|
2314 ; (View-process-highlight-recursive-all-childs
|
|
|
2315 ; (View-process-get-pid-from-current-line)))
|
|
|
2316
|
|
|
2317 ;;; kill processes
|
|
|
2318
|
|
|
2319 (defun View-process-send-signal-to-processes-with-mark (signal)
|
|
|
2320 "Sends a SIGNAL to all processes, which are marked."
|
|
|
2321 (interactive
|
|
|
2322 (let* ((View-process-stop-motion-help t)
|
|
|
2323 (signal (completing-read "Signal: "
|
|
|
2324 View-process-kill-signals
|
|
|
2325 nil
|
|
|
2326 t
|
|
|
2327 View-process-default-kill-signal
|
|
|
2328 View-process-signal-history)))
|
|
|
2329 (list signal)))
|
|
|
2330 (if View-process-pid-mark-alist
|
|
|
2331 (View-process-call-function-on-pid-and-mark-list
|
|
|
2332 'View-process-send-signal-to-process-in-line
|
|
|
2333 View-process-pid-mark-alist
|
|
|
2334 t
|
|
|
2335 signal)
|
|
|
2336 (error "ERROR: There is no marked process!.")))
|
|
|
2337
|
|
|
2338 (defun View-process-send-signal-to-processes-in-region (signal)
|
|
|
2339 "Sends a SIGNAL to all processes in the current region."
|
|
|
2340 (interactive
|
|
|
2341 (let* ((View-process-stop-motion-help t)
|
|
|
2342 (signal (completing-read "Signal: "
|
|
|
2343 View-process-kill-signals
|
|
|
2344 nil
|
|
|
2345 t
|
|
|
2346 View-process-default-kill-signal
|
|
|
2347 View-process-signal-history)))
|
|
|
2348 (list signal)))
|
|
|
2349 (let ((region-start (if (> (region-beginning) View-process-output-start)
|
|
|
2350 (region-beginning)
|
|
|
2351 View-process-output-start))
|
|
|
2352 (region-end (if (< (region-end) View-process-output-end)
|
|
|
2353 (region-end)
|
|
|
2354 View-process-output-end)))
|
|
|
2355 (save-excursion
|
|
|
2356 (goto-char region-start)
|
|
|
2357 (beginning-of-line)
|
|
|
2358 (let ((pid-list (View-process-get-pid-list-from-region (point)
|
|
|
2359 region-end)))
|
|
|
2360 (View-process-send-signal-to-processes-in-pid-list signal
|
|
|
2361 pid-list
|
|
|
2362 nil
|
|
|
2363 t)
|
|
|
2364 ))))
|
|
|
2365
|
|
|
2366 (defun View-process-send-signal-to-processes-in-pid-list (signal
|
|
|
2367 pid-list
|
|
|
2368 &optional
|
|
|
2369 dont-ask
|
|
|
2370 dont-update)
|
|
|
2371 "Sends a SIGNAL to all processes with a pid in PID-LIST.
|
|
|
2372 If DONT-ASK is non nil, then no confirmation question will be asked.
|
|
|
2373 If DONT-UPDATE is non nil, then the command `View-process-status-update'
|
|
|
2374 will not be run after sending a signal."
|
|
|
2375 (if (not pid-list)
|
|
|
2376 t
|
|
|
2377 (View-process-send-signal-to-process signal
|
|
|
2378 (car pid-list)
|
|
|
2379 dont-ask
|
|
|
2380 dont-update)
|
|
|
2381 (View-process-send-signal-to-processes-in-pid-list signal
|
|
|
2382 (cdr pid-list)
|
|
|
2383 dont-ask
|
|
|
2384 dont-update)))
|
|
|
2385
|
|
|
2386 (defun View-process-send-signal-to-process-in-line (signal)
|
|
|
2387 "Sends a SIGNAL to the process in the current line."
|
|
|
2388 (interactive
|
|
|
2389 (let* ((View-process-stop-motion-help t)
|
|
|
2390 (signal (completing-read "Signal: "
|
|
|
2391 View-process-kill-signals
|
|
|
2392 nil
|
|
|
2393 t
|
|
|
2394 View-process-default-kill-signal
|
|
|
2395 View-process-signal-history)))
|
|
|
2396 (list signal)))
|
|
|
2397 (if (and (>= (point) View-process-output-start)
|
|
|
2398 (< (point) View-process-output-end))
|
|
|
2399 (View-process-send-signal-to-process
|
|
|
2400 signal
|
|
|
2401 (View-process-get-pid-from-current-line)
|
|
|
2402 nil
|
|
|
2403 t)))
|
|
|
2404
|
|
|
2405 (defun View-process-send-key-as-signal-to-processes ()
|
|
|
2406 "Converts the key which invokes this command to a signal.
|
|
|
2407 After that it sends this signal to the process in the current line,
|
|
|
2408 or, if an active region exists, to all processes in the region.
|
|
|
2409 For this function only numbers could be used as keys."
|
|
|
2410 (interactive)
|
|
|
2411 (let ((signal (View-process-return-current-command-key-as-string)))
|
|
|
2412 (if (not (= 0 (string-to-int signal)))
|
|
|
2413 (if (View-process-region-active-p)
|
|
|
2414 (View-process-send-signal-to-processes-in-region signal)
|
|
|
2415 (View-process-send-signal-to-process-in-line signal))
|
|
|
2416 (error "ERROR: This command must be bind to and call by an integer!")
|
|
|
2417 )))
|
|
|
2418
|
|
|
2419 (defun View-process-send-signal-to-processes-g ()
|
|
|
2420 "Sends a signal to processes.
|
|
|
2421 It is a generic interface to `View-process-send-signal-to-processes-in-region'
|
|
|
2422 and `View-process-send-signal-to-process-in-line'. The first will be called
|
|
|
2423 if a region is active and the other one if not. If the region isn't
|
|
|
2424 active, but marks are set, then the function is called on every
|
|
|
2425 marked process."
|
|
|
2426 (interactive)
|
|
|
2427 (cond ((View-process-region-active-p)
|
|
|
2428 (call-interactively 'View-process-send-signal-to-processes-in-region))
|
|
|
2429 (View-process-pid-mark-alist
|
|
|
2430 (call-interactively 'View-process-send-signal-to-processes-with-mark))
|
|
|
2431 (t
|
|
|
2432 (call-interactively 'View-process-send-signal-to-process-in-line))))
|
|
|
2433
|
|
|
2434 (defun View-process-send-signal-to-process (signal
|
|
|
2435 pid
|
|
|
2436 &optional
|
|
|
2437 dont-ask
|
|
|
2438 dont-update)
|
|
|
2439 "Sends the SIGNAL to the process with the PID.
|
|
|
2440 If DONT-ASK is non nil, then no confirmation question will be asked.
|
|
|
2441 If DONT-UPDATE is non nil, then the command `View-process-status-update'
|
|
|
2442 will not be run after sending the signal."
|
|
|
2443 (interactive
|
|
|
2444 (let* ((View-process-stop-motion-help t)
|
|
|
2445 (signal (completing-read "Signal: "
|
|
|
2446 View-process-kill-signals
|
|
|
2447 nil
|
|
|
2448 t
|
|
|
2449 View-process-default-kill-signal
|
|
|
2450 View-process-signal-history))
|
|
|
2451 (pid (int-to-string (read-number "Process Id (PID): "))))
|
|
|
2452 (list signal pid)))
|
|
|
2453 (if (and (eq (string-to-int pid) (emacs-pid))
|
|
|
2454 (or (not View-process-remote-host)
|
|
|
2455 (string= View-process-remote-host (getenv "HOSTNAME"))))
|
|
|
2456 (error "Hey, are you a murderer? You've just tried to kill me!")
|
|
|
2457 (let (
|
|
|
2458 ; (signal-line-extent
|
|
|
2459 ; (View-process-highlight-line-with-pid
|
|
|
2460 ; pid
|
|
|
2461 ; 'View-process-signal-line-face
|
|
|
2462 ; View-process-signal-line-mark))
|
|
|
2463 (signal-number (car (cdr (assoc signal View-process-kill-signals)))))
|
|
|
2464 (View-process-mark-line-with-pid pid View-process-signal-line-mark)
|
|
|
2465 (if (or dont-ask
|
|
|
2466 (if (string= signal-number signal)
|
|
|
2467 (y-or-n-p (format
|
|
|
2468 "Do you realy want to send signal %s to PID %s "
|
|
|
2469 signal
|
|
|
2470 pid))
|
|
|
2471 (y-or-n-p
|
|
|
2472 (format "Do you realy want to send signal %s (%s) to PID %s "
|
|
|
2473 signal
|
|
|
2474 signal-number
|
|
|
2475 pid))))
|
|
|
2476 (progn
|
|
|
2477 (if View-process-remote-host
|
|
|
2478 (call-process View-process-rsh-command
|
|
|
2479 nil
|
|
|
2480 nil
|
|
|
2481 nil
|
|
|
2482 View-process-remote-host
|
|
|
2483 (concat View-process-signal-command
|
|
|
2484 " -"
|
|
|
2485 signal-number
|
|
|
2486 " "
|
|
|
2487 pid))
|
|
|
2488 (call-process View-process-signal-command
|
|
|
2489 nil
|
|
|
2490 nil
|
|
|
2491 nil
|
|
|
2492 (concat "-" signal-number)
|
|
|
2493 pid))
|
|
|
2494 (if (not dont-update)
|
|
|
2495 (View-process-status-update)
|
|
|
2496 (View-process-mark-line-with-pid pid
|
|
|
2497 View-process-signaled-line-mark)
|
|
|
2498 ))
|
|
|
2499 ; (View-process-delete-extent signal-line-extent)
|
|
|
2500 (if (View-process-goto-line-with-pid pid)
|
|
|
2501 (View-process-unmark-current-line))
|
|
|
2502 ))))
|
|
|
2503
|
|
|
2504
|
|
|
2505 ;;; renice processes
|
|
|
2506
|
|
|
2507 (defun View-process-read-nice-value ()
|
|
|
2508 "Reads and returns a valid nice value."
|
|
|
2509 (let ((nice-value nil)
|
|
|
2510 (min-value (if (string= (user-real-login-name) "root") -20 1))
|
|
|
2511 (prompt "Add nice value [%d ... 20]: "))
|
|
|
2512 (while (not nice-value)
|
|
|
2513 (setq nice-value (read-string (format prompt min-value)
|
|
|
2514 View-process-default-nice-value))
|
|
|
2515 (if (and (string= (int-to-string (string-to-int nice-value))
|
|
|
2516 nice-value)
|
|
|
2517 (>= (string-to-int nice-value) min-value)
|
|
|
2518 (<= (string-to-int nice-value) 20)
|
|
|
2519 (not (= (string-to-int nice-value) 0)))
|
|
|
2520 (if (> (string-to-int nice-value) 0)
|
|
|
2521 (setq nice-value
|
|
|
2522 (concat "+" (int-to-string (string-to-int nice-value)))))
|
|
|
2523 (setq nice-value nil)
|
|
|
2524 (setq prompt
|
|
|
2525 "Wrong Format! Try again. Add nice value [%d ... 20]: ")))
|
|
|
2526 nice-value))
|
|
|
2527
|
|
|
2528 (defun View-process-renice-process (nice-value
|
|
|
2529 pid
|
|
|
2530 &optional
|
|
|
2531 dont-ask
|
|
|
2532 dont-update)
|
|
|
2533 "Alter priority of the process with the PID.
|
|
|
2534 NICE-VALUE is the value, which will be added to the old nice value.
|
|
|
2535 If DONT-ASK is non nil, then no confirmation question will be asked.
|
|
|
2536 If DONT-UPDATE is non nil, then the command `View-process-status-update'
|
|
|
2537 will not be run after renicing."
|
|
|
2538 (interactive
|
|
|
2539 (let* ((View-process-stop-motion-help t)
|
|
|
2540 (nice-value (View-process-read-nice-value))
|
|
|
2541 (pid (int-to-string (read-number "Process Id (PID): "))))
|
|
|
2542 (list nice-value pid)))
|
|
|
2543 ; (let ((signal-line-extent
|
|
|
2544 ; (View-process-highlight-line-with-pid
|
|
|
2545 ; pid
|
|
|
2546 ; 'View-process-signal-line-face
|
|
|
2547 ; View-process-renice-line-mark)))
|
|
|
2548 (View-process-mark-line-with-pid pid View-process-renice-line-mark)
|
|
|
2549 (if (or dont-ask
|
|
|
2550 (y-or-n-p (format
|
|
|
2551 "Do you realy want to renice PID %s with %s "
|
|
|
2552 pid
|
|
|
2553 nice-value)))
|
|
|
2554 (progn
|
|
|
2555 (if View-process-remote-host
|
|
|
2556 (call-process View-process-rsh-command
|
|
|
2557 nil
|
|
|
2558 nil
|
|
|
2559 nil
|
|
|
2560 View-process-remote-host
|
|
|
2561 (concat View-process-renice-command
|
|
|
2562 " "
|
|
|
2563 nice-value
|
|
|
2564 " "
|
|
|
2565 pid))
|
|
|
2566 (call-process View-process-renice-command
|
|
|
2567 nil
|
|
|
2568 nil
|
|
|
2569 nil
|
|
|
2570 nice-value
|
|
|
2571 pid))
|
|
|
2572 (if (not dont-update)
|
|
|
2573 (View-process-status-update)
|
|
|
2574 (View-process-mark-line-with-pid pid View-process-signaled-line-mark)
|
|
|
2575 ))
|
|
|
2576 ; (View-process-delete-extent signal-line-extent)
|
|
|
2577 (if (View-process-goto-line-with-pid pid)
|
|
|
2578 (View-process-unmark-current-line))))
|
|
|
2579
|
|
|
2580 (defun View-process-renice-processes-with-mark (nice-value)
|
|
|
2581 "Alter priority of all processes, which are marked.
|
|
|
2582 NICE-VALUE is the value, which will be added to the old nice value."
|
|
|
2583 (interactive
|
|
|
2584 (let* ((View-process-stop-motion-help t)
|
|
|
2585 (nice-value (View-process-read-nice-value)))
|
|
|
2586 (list nice-value)))
|
|
|
2587 (if View-process-pid-mark-alist
|
|
|
2588 (View-process-call-function-on-pid-and-mark-list
|
|
|
2589 'View-process-renice-process-in-line
|
|
|
2590 View-process-pid-mark-alist
|
|
|
2591 t
|
|
|
2592 nice-value)
|
|
|
2593 (error "ERROR: There is no marked process!.")))
|
|
|
2594
|
|
|
2595 (defun View-process-renice-processes-in-region (nice-value)
|
|
|
2596 "Alter priority of all processes in the current region.
|
|
|
2597 NICE-VALUE is the value, which will be added to the old nice value."
|
|
|
2598 (interactive
|
|
|
2599 (let* ((View-process-stop-motion-help t)
|
|
|
2600 (nice-value (View-process-read-nice-value)))
|
|
|
2601 (list nice-value)))
|
|
|
2602 (let ((region-start (if (> (region-beginning) View-process-output-start)
|
|
|
2603 (region-beginning)
|
|
|
2604 View-process-output-start))
|
|
|
2605 (region-end (if (< (region-end) View-process-output-end)
|
|
|
2606 (region-end)
|
|
|
2607 View-process-output-end)))
|
|
|
2608 (save-excursion
|
|
|
2609 (goto-char region-start)
|
|
|
2610 (beginning-of-line)
|
|
|
2611 (let ((pid-list (View-process-get-pid-list-from-region (point)
|
|
|
2612 region-end)))
|
|
|
2613 (View-process-renice-processes-in-pid-list nice-value pid-list nil t)
|
|
|
2614 ))))
|
|
|
2615
|
|
|
2616 (defun View-process-renice-processes-in-pid-list (nice-value
|
|
|
2617 pid-list
|
|
|
2618 &optional
|
|
|
2619 dont-ask
|
|
|
2620 dont-update)
|
|
|
2621 "Alter priority all processes with a pid in PID-LIST.
|
|
|
2622 NICE-VALUE is the value, which will be added to the old nice value.
|
|
|
2623 If DONT-ASK is non nil, then no confirmation question will be asked.
|
|
|
2624 If DONT-UPDATE is non nil, then the command `View-process-status-update'
|
|
|
2625 will not be run after renicing"
|
|
|
2626 (if (not pid-list)
|
|
|
2627 t
|
|
|
2628 (View-process-renice-process nice-value
|
|
|
2629 (car pid-list)
|
|
|
2630 dont-ask
|
|
|
2631 dont-update)
|
|
|
2632 (View-process-renice-processes-in-pid-list nice-value
|
|
|
2633 (cdr pid-list)
|
|
|
2634 dont-ask
|
|
|
2635 dont-update)))
|
|
|
2636
|
|
|
2637 (defun View-process-renice-process-in-line (nice-value)
|
|
|
2638 "Alter priority of to the process in the current line.
|
|
|
2639 NICE-VALUE is the value, which will be added to the old nice value."
|
|
|
2640 (interactive
|
|
|
2641 (let* ((View-process-stop-motion-help t)
|
|
|
2642 (nice-value (View-process-read-nice-value)))
|
|
|
2643 (list nice-value)))
|
|
|
2644 (if (and (>= (point) View-process-output-start)
|
|
|
2645 (< (point) View-process-output-end))
|
|
|
2646 (View-process-renice-process
|
|
|
2647 nice-value
|
|
|
2648 (View-process-get-pid-from-current-line)
|
|
|
2649 nil
|
|
|
2650 t)))
|
|
|
2651
|
|
|
2652 (defun View-process-renice-processes-g ()
|
|
|
2653 "Alter priority of processes.
|
|
|
2654 It is a generic interface to `View-process-renice-processes-in-region'
|
|
|
2655 and `View-process-renice-process-in-line'. The first will be called
|
|
|
2656 if a region is active and the other one if not. If the region isn't
|
|
|
2657 active, but marks are set, then the function is called on every
|
|
|
2658 marked process."
|
|
|
2659 (interactive)
|
|
|
2660 (cond ((View-process-region-active-p)
|
|
|
2661 (call-interactively 'View-process-renice-processes-in-region))
|
|
|
2662 (View-process-pid-mark-alist
|
|
|
2663 (call-interactively 'View-process-renice-processes-with-mark))
|
|
|
2664 (t
|
|
|
2665 (call-interactively 'View-process-renice-process-in-line))))
|
|
|
2666
|
|
|
2667
|
|
|
2668 ;;; Returning field values
|
|
|
2669
|
|
|
2670 (defun View-process-get-pid-from-current-line ()
|
|
|
2671 "Returns a string with the pid of the process in the current line."
|
|
|
2672 (View-process-get-field-value-from-current-line
|
|
|
2673 (View-process-translate-field-name-to-position View-process-pid-field-name)
|
|
|
2674 View-process-max-fields)
|
|
|
2675 )
|
|
|
2676
|
|
|
2677 (defun View-process-get-ppid-from-current-line ()
|
|
|
2678 "Returns a string with the ppid of the process in the current line."
|
|
|
2679 (View-process-get-field-value-from-current-line
|
|
|
2680 (View-process-translate-field-name-to-position View-process-ppid-field-name)
|
|
|
2681 View-process-max-fields)
|
|
|
2682 )
|
|
|
2683
|
|
|
2684 (defun View-process-get-pid-list-from-region (begin end)
|
|
|
2685 "Returns a list with all PID's in the region from BEGIN to END."
|
|
|
2686 (goto-char begin)
|
|
|
2687 (if (>= (point) end)
|
|
|
2688 nil
|
|
|
2689 (cons (View-process-get-pid-from-current-line)
|
|
|
2690 (progn (forward-line)
|
|
|
2691 (View-process-get-pid-list-from-region (point) end)))))
|
|
|
2692
|
|
|
2693 (defun View-process-get-pid-ppid-list-from-region (begin end)
|
|
|
2694 "Returns a list with all PID's ant its PPID's in the region
|
|
|
2695 from BEGIN to END. END must be greater than BEGIN."
|
|
|
2696 (goto-char begin)
|
|
|
2697 (if (>= (point) end)
|
|
|
2698 nil
|
|
|
2699 (cons (cons (View-process-get-pid-from-current-line)
|
|
|
2700 (View-process-get-ppid-from-current-line))
|
|
|
2701 (progn (forward-line)
|
|
|
2702 (View-process-get-pid-ppid-list-from-region (point) end)))))
|
|
|
2703
|
|
|
2704 (defun View-process-get-field-value-from-current-line (field-no max-fields)
|
|
|
2705 "Returns the value of the field FIELD-NO from the current line as string.
|
|
|
2706 If the FIELD-NO is >= max-fields, then the rest of the line after the
|
|
|
2707 start of the field FIELD-NO will be returned."
|
|
|
2708 (save-excursion
|
|
|
2709 (View-process-jump-to-field field-no max-fields)
|
|
|
2710 (if (>= field-no max-fields)
|
|
|
2711 (buffer-substring (point) (View-process-return-end-of-line))
|
|
|
2712 (current-word)))
|
|
|
2713 )
|
|
|
2714
|
|
|
2715 (defun View-process-jump-to-field (field-no max-fields)
|
|
|
2716 "Sets the point at the start of field FIELD-NO in the current line.
|
|
|
2717 MAX_FIELDS is used instead of FIELD-NO, if FIELD-NO > MAX_FIELDS."
|
|
|
2718 (View-process-replaces-blanks-in-fields-if-necessary)
|
|
|
2719 (beginning-of-line)
|
|
|
2720 (skip-chars-forward " ")
|
|
|
2721 (if (< field-no 1)
|
|
|
2722 (error "Parameter FIELD-NO must be >= 1"))
|
|
|
2723 (if (> field-no max-fields)
|
|
|
2724 (setq field-no max-fields))
|
|
|
2725 (if (= field-no 1)
|
|
|
2726 (point)
|
|
|
2727 (skip-chars-forward "^ ")
|
|
|
2728 (skip-chars-forward " ")
|
|
|
2729 (View-process-jump-to-field-1 (1- field-no))))
|
|
|
2730
|
|
|
2731 (defun View-process-jump-to-field-1 (field-no)
|
|
|
2732 "Internal function of View-process-jump-to-field"
|
|
|
2733 (if (= field-no 1)
|
|
|
2734 (point)
|
|
|
2735 (skip-chars-forward "^ ")
|
|
|
2736 (skip-chars-forward " ")
|
|
|
2737 (View-process-jump-to-field-1 (1- field-no))))
|
|
|
2738
|
|
|
2739
|
|
|
2740 (defun View-process-display-emacs-pid ()
|
|
|
2741 "Sets the point to the line with the emacs process."
|
|
|
2742 (interactive)
|
|
|
2743 (message (format "This emacs has the PID `%d'!" (emacs-pid))))
|
|
|
2744
|
|
|
2745
|
|
|
2746 ;;; mouse functions
|
|
|
2747
|
|
|
2748 (defun View-process-mouse-kill (event)
|
|
|
2749 "Function for kill a process with the mouse."
|
|
|
2750 (interactive "e")
|
|
|
2751 (mouse-set-point event)
|
|
|
2752 (View-process-send-signal-to-process-in-line "SIGTERM"))
|
|
|
2753
|
|
|
2754
|
|
|
2755 ;;; Highlighting functions
|
|
|
2756
|
|
|
2757 (defun View-process-highlight-current-line (face)
|
|
|
2758 "Highlights the current line with the FACE."
|
|
|
2759 (let ((read-only buffer-read-only))
|
|
|
2760 (setq buffer-read-only nil)
|
|
|
2761 (let ((extent (make-extent (View-process-return-beginning-of-line)
|
|
|
2762 (View-process-return-end-of-line))))
|
|
|
2763 (set-extent-face extent face)
|
|
|
2764 (setq buffer-read-only read-only)
|
|
|
2765 extent)
|
|
|
2766 ))
|
|
|
2767
|
|
|
2768 (defun View-process-goto-line-with-pid (pid)
|
|
|
2769 "Sets the point in the line with the PID.
|
|
|
2770 It returns nil, if there is no line with the PID in the output."
|
|
|
2771 (if (string= pid (View-process-get-pid-from-current-line))
|
|
|
2772 t
|
|
|
2773 (goto-char View-process-output-start)
|
|
|
2774 (while (and (< (point) View-process-output-end)
|
|
|
2775 (not (string= pid (View-process-get-pid-from-current-line))))
|
|
|
2776 (forward-line))
|
|
|
2777 (< (point) View-process-output-end)))
|
|
|
2778
|
|
|
2779 ;(defun View-process-highlight-line-with-pid (pid face mark)
|
|
|
2780 ; "Highlights the line with the PID with the FACE and sets the MARK.
|
|
|
2781 ;It returns the extent of the line."
|
|
|
2782 ; (save-excursion
|
|
|
2783 ; (View-process-goto-line-with-pid pid)
|
|
|
2784 ; (View-process-set-mark-in-current-line mark)
|
|
|
2785 ; (View-process-save-pid-and-mark pid mark)
|
|
|
2786 ; (View-process-highlight-current-line face)
|
|
|
2787 ; ))
|
|
|
2788
|
|
|
2789 ;(defun View-process-delete-extent (extent)
|
|
|
2790 ; "Deletes the extent EXTENT."
|
|
|
2791 ; (let ((read-only buffer-read-only))
|
|
|
2792 ; (save-excursion
|
|
|
2793 ; (goto-char (extent-start-position extent))
|
|
|
2794 ; (View-process-set-mark-in-current-line View-process-no-mark)
|
|
|
2795 ; (setq buffer-read-only nil)
|
|
|
2796 ; (delete-extent extent)
|
|
|
2797 ; (setq buffer-read-only read-only))))
|
|
|
2798
|
|
|
2799 ;;; mark functions
|
|
|
2800
|
|
|
2801 (defun View-process-save-pid-and-mark (pid mark)
|
|
|
2802 "Saves the PID and the MARK in a special alist.
|
|
|
2803 The name of the alist is `View-process-pid-mark-alist'."
|
|
|
2804 (if (assoc pid View-process-pid-mark-alist)
|
|
|
2805 (setcdr (assoc pid View-process-pid-mark-alist) (list mark ))
|
|
|
2806 (setq View-process-pid-mark-alist
|
|
|
2807 (cons (list pid mark) View-process-pid-mark-alist))))
|
|
|
2808
|
|
|
2809 (defun View-process-remove-pid-and-mark-1 (pid pid-mark-alist)
|
|
|
2810 "Internal function of `View-process-remove-pid-and-mark'."
|
|
|
2811 (cond ((not pid-mark-alist)
|
|
|
2812 nil)
|
|
|
2813 ((string= pid (car (car pid-mark-alist)))
|
|
|
2814 (View-process-remove-pid-and-mark-1 pid (cdr pid-mark-alist)))
|
|
|
2815 (t
|
|
|
2816 (cons (car pid-mark-alist)
|
|
|
2817 (View-process-remove-pid-and-mark-1 pid (cdr pid-mark-alist)))
|
|
|
2818 )))
|
|
|
2819
|
|
|
2820 (defun View-process-remove-pid-and-mark (pid)
|
|
|
2821 "Removes the PID from the alist `View-process-pid-mark-alist'."
|
|
|
2822 (setq View-process-pid-mark-alist
|
|
|
2823 (View-process-remove-pid-and-mark-1 pid View-process-pid-mark-alist))
|
|
|
2824 )
|
|
|
2825
|
|
|
2826 (defun View-process-set-mark-in-current-line (mark)
|
|
|
2827 "Sets the MARK at the start of the current line."
|
|
|
2828 (let ((buffer-read-only nil))
|
|
|
2829 (save-excursion
|
|
|
2830 (beginning-of-line)
|
|
|
2831 (delete-char 1)
|
|
|
2832 (insert mark))))
|
|
|
2833
|
|
|
2834 (defun View-process-mark-line-with-pid (pid &optional mark)
|
|
|
2835 "Sets the MARK in the line with the PID.
|
|
|
2836 It uses the 'View-process-single-line-mark', if mark is nil."
|
|
|
2837 ; (interactive "sPID: ")
|
|
|
2838 (interactive (let ((View-process-stop-motion-help t))
|
|
|
2839 (list (read-string "PID: "))))
|
|
|
2840 (save-excursion
|
|
|
2841 (View-process-goto-line-with-pid pid)
|
|
|
2842 (View-process-set-mark-in-current-line (or mark
|
|
|
2843 View-process-single-line-mark))
|
|
|
2844 (View-process-save-pid-and-mark pid
|
|
|
2845 (or mark
|
|
|
2846 View-process-single-line-mark))
|
|
|
2847 ))
|
|
|
2848
|
|
|
2849 (defun View-process-mark-current-line (&optional mark)
|
|
|
2850 "Sets a mark in the current line.
|
|
|
2851 It uses the 'View-process-single-line-mark' if MARK is nil."
|
|
|
2852 (interactive)
|
|
|
2853 (if (or (< (point) View-process-output-start)
|
|
|
2854 (> (point) View-process-output-end))
|
|
|
2855 (error "ERROR: Not in a process line!")
|
|
|
2856 (View-process-set-mark-in-current-line (or mark
|
|
|
2857 View-process-single-line-mark))
|
|
|
2858 (View-process-save-pid-and-mark (View-process-get-pid-from-current-line)
|
|
|
2859 (or mark
|
|
|
2860 View-process-single-line-mark))))
|
|
|
2861
|
|
|
2862
|
|
|
2863 (defun View-process-unmark-current-line ()
|
|
|
2864 "Unsets a mark in the current line."
|
|
|
2865 (interactive)
|
|
|
2866 (if (and (>= (point) View-process-output-start)
|
|
|
2867 (<= (point) View-process-output-end))
|
|
|
2868 (progn
|
|
|
2869 (View-process-remove-pid-and-mark
|
|
|
2870 (View-process-get-pid-from-current-line))
|
|
|
2871 (View-process-set-mark-in-current-line View-process-no-mark)
|
|
|
2872 )
|
|
|
2873 (error "ERROR: Not in a process line!")))
|
|
|
2874
|
|
|
2875 (defun View-process-mark-process-tree (process-tree)
|
|
|
2876 "Marks all processes in the list process-tree."
|
|
|
2877 (cond ((not process-tree))
|
|
|
2878 ((listp (car process-tree))
|
|
|
2879 (View-process-mark-process-tree (car process-tree))
|
|
|
2880 (View-process-mark-process-tree (cdr process-tree)))
|
|
|
2881 ((stringp (car process-tree))
|
|
|
2882 (View-process-mark-line-with-pid (car process-tree)
|
|
|
2883 View-process-child-line-mark)
|
|
|
2884 (View-process-mark-process-tree (cdr process-tree)))
|
|
|
2885 (t (error "Bug in 'View-process-mark-process-tree' !"))))
|
|
|
2886
|
|
|
2887 (defun View-process-mark-childs (pid)
|
|
|
2888 "Marks all childs of the process with the PID."
|
|
|
2889 ; (interactive "sParent PID: ")
|
|
|
2890 (interactive (let ((View-process-stop-motion-help t))
|
|
|
2891 (list (read-string "Parent PID: "))))
|
|
|
2892 (if (not
|
|
|
2893 (View-process-field-name-exists-p View-process-ppid-field-name))
|
|
|
2894 (error "ERROR: No field `%s' in the output. Try `M-x ps -j' to get it."
|
|
|
2895 View-process-ppid-field-name)
|
|
|
2896 (View-process-mark-line-with-pid pid View-process-parent-line-mark)
|
|
|
2897 (View-process-mark-process-tree
|
|
|
2898 (cdr (View-process-get-child-process-tree pid)))))
|
|
|
2899
|
|
|
2900 (defun View-process-mark-childs-in-current-line ()
|
|
|
2901 "Marks all the child processes of the process in the current line."
|
|
|
2902 (interactive)
|
|
|
2903 (View-process-mark-childs
|
|
|
2904 (View-process-get-pid-from-current-line)))
|
|
|
2905
|
|
|
2906 (defun View-process-call-function-on-pid-and-mark-list (function
|
|
|
2907 pid-mark-alist
|
|
|
2908 &optional
|
|
|
2909 not-interactive
|
|
|
2910 &rest
|
|
|
2911 non-interactive-args)
|
|
|
2912 "Calls the FUNCTION on every process in the PID-MARK-ALIST.
|
|
|
2913 FUNCTION must be an interactive function, which works on the
|
|
|
2914 process in the current line, if INTERACTIVE is nil.
|
|
|
2915 If INTERACTIVE is t, then the function will be called non interactive
|
|
|
2916 with the NON-INTERACTIVE-ARGS."
|
|
|
2917 (cond ((not pid-mark-alist))
|
|
|
2918 ((View-process-goto-line-with-pid (car (car pid-mark-alist)))
|
|
|
2919 (if not-interactive
|
|
|
2920 (eval (cons function non-interactive-args))
|
|
|
2921 (call-interactively function))
|
|
|
2922 (eval (append (list 'View-process-call-function-on-pid-and-mark-list
|
|
|
2923 'function
|
|
|
2924 '(cdr pid-mark-alist)
|
|
|
2925 'not-interactive)
|
|
|
2926 non-interactive-args)))
|
|
|
2927 (t
|
|
|
2928 (eval (append (list 'View-process-call-function-on-pid-and-mark-list
|
|
|
2929 'function
|
|
|
2930 '(cdr pid-mark-alist)
|
|
|
2931 'not-interactive)
|
|
|
2932 non-interactive-args)))
|
|
|
2933 ))
|
|
|
2934
|
|
|
2935 (defun View-process-set-marks-from-pid-mark-alist (pid-mark-alist)
|
|
|
2936 "Sets the marks of the PID-MARK-ALIST to the pids of the PID-MARK-ALIST."
|
|
|
2937 (cond ((not pid-mark-alist))
|
|
|
2938 ((View-process-goto-line-with-pid (car (car pid-mark-alist)))
|
|
|
2939 (View-process-mark-current-line (car (cdr (car pid-mark-alist))))
|
|
|
2940 (View-process-set-marks-from-pid-mark-alist (cdr pid-mark-alist)))
|
|
|
2941 (t
|
|
|
2942 (View-process-set-marks-from-pid-mark-alist (cdr pid-mark-alist)))))
|
|
|
2943
|
|
|
2944 (defun View-process-reset-last-marks ()
|
|
|
2945 "Resets the last marks."
|
|
|
2946 (interactive)
|
|
|
2947 (View-process-set-marks-from-pid-mark-alist View-process-last-pid-mark-alist)
|
|
|
2948 )
|
|
|
2949
|
|
|
2950 (defun View-process-unmark-all ()
|
|
|
2951 "Unmarks all processes."
|
|
|
2952 (interactive)
|
|
|
2953 (View-process-call-function-on-pid-and-mark-list
|
|
|
2954 'View-process-unmark-current-line
|
|
|
2955 View-process-pid-mark-alist
|
|
|
2956 t))
|
|
|
2957
|
|
|
2958
|
|
|
2959 ;;; commands to moving around in a ps buffer
|
|
|
2960
|
|
|
2961 (defun View-process-output-start ()
|
|
|
2962 "Set point to the first field after the output start."
|
|
|
2963 (interactive)
|
|
|
2964 (goto-char View-process-output-start)
|
|
|
2965 (skip-chars-forward " "))
|
|
|
2966
|
|
|
2967 (defun View-process-output-end ()
|
|
|
2968 "Set point to the first field before the output end."
|
|
|
2969 (interactive)
|
|
|
2970 (goto-char View-process-output-end)
|
|
|
2971 (skip-chars-backward " ")
|
|
|
2972 (skip-chars-backward "^ "))
|
|
|
2973
|
|
|
2974 (defun View-process-next-field ()
|
|
|
2975 "Moves forward one field."
|
|
|
2976 (interactive)
|
|
|
2977 (if (< (point) View-process-output-start)
|
|
|
2978 (View-process-output-start)
|
|
|
2979 (skip-chars-forward " ")
|
|
|
2980 (if (< (point) View-process-output-end)
|
|
|
2981 (if (= View-process-max-fields (View-process-current-field-number))
|
|
|
2982 (progn
|
|
|
2983 (forward-line)
|
|
|
2984 (skip-chars-forward " ")
|
|
|
2985 (if (>= (point) View-process-output-end)
|
|
|
2986 (progn
|
|
|
2987 (goto-char View-process-output-start)
|
|
|
2988 (skip-chars-forward " "))))
|
|
|
2989 (skip-chars-forward "^ ")
|
|
|
2990 (skip-chars-forward " ")
|
|
|
2991 )
|
|
|
2992 (goto-char View-process-output-start)
|
|
|
2993 (skip-chars-forward " "))))
|
|
|
2994
|
|
|
2995 (defun View-process-previous-field ()
|
|
|
2996 "Moves backward one field."
|
|
|
2997 (interactive)
|
|
|
2998 (skip-chars-backward " ")
|
|
|
2999 (backward-char)
|
|
|
3000 (if (> (point) View-process-output-start)
|
|
|
3001 (if (= View-process-max-fields (View-process-current-field-number))
|
|
|
3002 (View-process-jump-to-field View-process-max-fields
|
|
|
3003 View-process-max-fields)
|
|
|
3004 (skip-chars-backward "^ \n")
|
|
|
3005 (if (< (point) View-process-output-start)
|
|
|
3006 (progn
|
|
|
3007 (goto-char View-process-output-end)
|
|
|
3008 (forward-line -1)
|
|
|
3009 (View-process-jump-to-field View-process-max-fields
|
|
|
3010 View-process-max-fields))))
|
|
|
3011 (goto-char View-process-output-end)
|
|
|
3012 (forward-line -1)
|
|
|
3013 (View-process-jump-to-field View-process-max-fields
|
|
|
3014 View-process-max-fields)))
|
|
|
3015
|
|
|
3016 (defun View-process-goto-first-field-next-line ()
|
|
|
3017 "Set point to the first field in the next line."
|
|
|
3018 (interactive)
|
|
|
3019 (if (< (point) View-process-output-start)
|
|
|
3020 (View-process-output-start)
|
|
|
3021 (forward-line)
|
|
|
3022 (if (>= (point) View-process-output-end)
|
|
|
3023 (View-process-output-start)
|
|
|
3024 (View-process-jump-to-field 1 View-process-max-fields))))
|
|
|
3025
|
|
|
3026
|
|
|
3027 ;;; buffer renaming
|
|
|
3028
|
|
|
3029 (defun View-process-rename-current-output-buffer (new-buffer-name)
|
|
|
3030 "Renames the ps output buffer to NEW-BUFFER-NAME."
|
|
|
3031 (interactive
|
|
|
3032 (let ((View-process-stop-motion-help t))
|
|
|
3033 (list
|
|
|
3034 (read-string "New PS output buffer name: "
|
|
|
3035 (generate-new-buffer-name
|
|
|
3036 (concat "*ps-"
|
|
|
3037 (or View-process-remote-host
|
|
|
3038 (getenv "HOSTNAME"))
|
|
|
3039 "*"))))))
|
|
|
3040 (if (not (string= mode-name View-process-mode-name))
|
|
|
3041 (error "ERROR: Not in a View-process-mode buffer!")
|
|
|
3042 (if (get-buffer new-buffer-name)
|
|
|
3043 (error "ERROR: Buffer %s exists!" new-buffer-name)
|
|
|
3044 (rename-buffer new-buffer-name)
|
|
|
3045 (setq View-process-buffer-name new-buffer-name)
|
|
|
3046 (if (or View-process-display-with-2-windows
|
|
|
3047 (get-buffer View-process-header-buffer-name))
|
|
|
3048 (let ((new-header-buffer-name
|
|
|
3049 (generate-new-buffer-name
|
|
|
3050 (concat (substring new-buffer-name 0 -1)
|
|
|
3051 " header*")))
|
|
|
3052 (buffer (current-buffer)))
|
|
|
3053 (set-buffer View-process-header-buffer-name)
|
|
|
3054 (rename-buffer new-header-buffer-name)
|
|
|
3055 (set-buffer buffer)
|
|
|
3056 (setq View-process-header-buffer-name new-header-buffer-name))
|
|
|
3057 ))))
|
|
|
3058
|
|
|
3059 ;;; For newer versions of field.el
|
|
|
3060 (if (not (fboundp 'sort-float-fields))
|
|
|
3061 (defalias 'sort-float-fields 'sort-numeric-fields))
|
|
|
3062
|
|
|
3063
|
|
|
3064 ;;; Display Functions
|
|
|
3065
|
|
|
3066 (defun View-process-header-mode ()
|
|
|
3067 "The mode of the buffer with the view process header."
|
|
|
3068 (set-syntax-table View-process-mode-syntax-table)
|
|
|
3069 (setq major-mode 'View-process-header-mode
|
|
|
3070 mode-name View-process-header-mode-name)
|
|
|
3071 (setq truncate-lines View-process-truncate-lines)
|
|
|
3072 ; (setq buffer-modeline (not View-process-header-mode-line-off))
|
|
|
3073 (view-process-switch-buffer-modeline (not View-process-header-mode-line-off))
|
|
|
3074 (run-hooks 'View-process-header-mode-hook)
|
|
|
3075 )
|
|
|
3076
|
|
|
3077 (defun View-process-top-window-p (&optional window)
|
|
|
3078 "Returns t, if the WINDOW is the top one.
|
|
|
3079 If WINDOW is nil, then the current window is tested."
|
|
|
3080 (eq 0 (car (cdr (window-pixel-edges window)))))
|
|
|
3081
|
|
|
3082 (defun View-process-change-display-type (display-with-2-windows)
|
|
|
3083 "If DISPLAY-WITH-2-WINDOWS is non nil, then a 2 windows display is used."
|
|
|
3084 (if display-with-2-windows
|
|
|
3085 (let ((window-size View-process-ps-header-window-size))
|
|
|
3086 (cond ((eq (count-windows 'NO-MINI) 1)
|
|
|
3087 ;; split window
|
|
|
3088 (split-window nil window-size)
|
|
|
3089 (select-window (next-window nil 'no-minibuf))
|
|
|
3090 )
|
|
|
3091 ((= (count-windows 'NO-MINI) 2)
|
|
|
3092 (if (View-process-top-window-p)
|
|
|
3093 (progn
|
|
|
3094 ;; delete other windows
|
|
|
3095 (delete-other-windows)
|
|
|
3096 ;; split window
|
|
|
3097 (split-window nil window-size))
|
|
|
3098 (select-window (next-window nil 'no-minibuf))
|
|
|
3099 ; (shrink-window (- (window-height) window-size))
|
|
|
3100 )
|
|
|
3101 (select-window (next-window nil 'no-minibuf))
|
|
|
3102 )
|
|
|
3103 ((> (count-windows 'NO-MINI) 2)
|
|
|
3104 ;; delete other windows
|
|
|
3105 (delete-other-windows)
|
|
|
3106 ;; split window
|
|
|
3107 (split-window nil window-size)
|
|
|
3108 (select-window (next-window nil 'no-minibuf))
|
|
|
3109 ))
|
|
|
3110 ;; copy header lines
|
|
|
3111 (let ((header-lines (buffer-substring (point-min)
|
|
|
3112 View-process-header-end))
|
|
|
3113 (buffer (get-buffer-create View-process-header-buffer-name)))
|
|
|
3114 (select-window (next-window nil 'no-minibuf))
|
|
|
3115 ;; load *ps-header* buffer in window
|
|
|
3116 (set-window-buffer (get-buffer-window (current-buffer)) buffer)
|
|
|
3117 (setq buffer-read-only nil)
|
|
|
3118 (erase-buffer)
|
|
|
3119 ;; insert header lines
|
|
|
3120 (insert header-lines)
|
|
|
3121 (setq buffer-read-only t)
|
|
|
3122 (goto-char (point-min))
|
|
|
3123 (View-process-header-mode)
|
|
|
3124 (if (not (= (window-height) window-size))
|
|
|
3125 (shrink-window (- (window-height) window-size)))
|
|
|
3126 (select-window (next-window nil 'no-minibuf))
|
|
|
3127 ))
|
|
|
3128 (let ((header-buffer (get-buffer View-process-header-buffer-name)))
|
|
|
3129 (if header-buffer
|
|
|
3130 (progn
|
|
|
3131 (if (get-buffer-window header-buffer)
|
|
|
3132 (delete-window (get-buffer-window header-buffer)))
|
|
|
3133 (kill-buffer header-buffer))))))
|
|
|
3134
|
|
|
3135 (defun View-process-toggle-display-with-2-windows (&optional arg)
|
|
|
3136 "Change whether the view process output is displayed with two windows.
|
|
|
3137 With ARG, set `View-process-display-with-2-windows' to t, if ARG is
|
|
|
3138 positive. ARG is a prefix arg."
|
|
|
3139 (interactive "P")
|
|
|
3140 (if arg
|
|
|
3141 (if (>= (prefix-numeric-value arg) 0)
|
|
|
3142 (setq View-process-display-with-2-windows t)
|
|
|
3143 (setq View-process-display-with-2-windows nil))
|
|
|
3144 (if View-process-display-with-2-windows
|
|
|
3145 (setq View-process-display-with-2-windows nil)
|
|
|
3146 (setq View-process-display-with-2-windows t)))
|
|
|
3147 (View-process-change-display-type View-process-display-with-2-windows)
|
|
|
3148 (if View-process-display-with-2-windows
|
|
|
3149 (View-process-toggle-hide-header '(1))
|
|
|
3150 (View-process-toggle-hide-header '(-1))))
|
|
|
3151
|
|
|
3152 (defun View-process-save-old-window-configuration ()
|
|
|
3153 "Saves the window configuration before the first call of view process."
|
|
|
3154 (if (not View-process-old-window-configuration)
|
|
|
3155 (setq View-process-old-window-configuration
|
|
|
3156 (current-window-configuration))
|
|
|
3157 ))
|
|
|
3158
|
|
|
3159 (defun View-process-hide-header (hide-header)
|
|
|
3160 "Hides the header lines in the view processes buffer, if HIDE-HEADER is t."
|
|
|
3161 (if hide-header
|
|
|
3162 (if (<= View-process-output-start (point-max))
|
|
|
3163 (narrow-to-region View-process-output-start (point-max))
|
|
|
3164 (narrow-to-region (point-max) (point-max)))
|
|
|
3165 (widen)))
|
|
|
3166
|
|
|
3167 (defun View-process-toggle-hide-header (&optional arg)
|
|
|
3168 "Change whether the header are hided.
|
|
|
3169 With ARG, set `View-process-hide-header' to t, if ARG is positive.
|
|
|
3170 ARG is a prefix arg."
|
|
|
3171 (interactive "P")
|
|
|
3172 (if arg
|
|
|
3173 (if (>= (prefix-numeric-value arg) 0)
|
|
|
3174 (setq View-process-hide-header t)
|
|
|
3175 (setq View-process-hide-header nil))
|
|
|
3176 (if View-process-hide-header
|
|
|
3177 (setq View-process-hide-header nil)
|
|
|
3178 (setq View-process-hide-header t)))
|
|
|
3179 (View-process-hide-header View-process-hide-header))
|
|
|
3180
|
|
|
3181 ;;; Misc. commands
|
|
|
3182
|
|
|
3183 (defun View-process-quit ()
|
|
|
3184 "Kills the *ps* buffer."
|
|
|
3185 (interactive)
|
|
|
3186 (if (y-or-n-p
|
|
|
3187 "Do you want really want to quit the view process mode? ")
|
|
|
3188 (progn
|
|
|
3189 (if (get-buffer View-process-buffer-name)
|
|
|
3190 (kill-buffer View-process-buffer-name))
|
|
|
3191 (if (or View-process-display-with-2-windows
|
|
|
3192 (get-buffer View-process-header-buffer-name))
|
|
|
3193 (kill-buffer View-process-header-buffer-name))
|
|
|
3194 (set-window-configuration View-process-old-window-configuration)
|
|
|
3195 (setq View-process-old-window-configuration nil)
|
|
|
3196 )))
|
|
|
3197
|
|
|
3198 (defun View-process-submit-bug-report ()
|
|
|
3199 "Submit via mail a bug report on View-process-mode."
|
|
|
3200 (interactive)
|
|
|
3201 (require 'reporter)
|
|
|
3202 (let ((bsd-or-system-v (View-process-bsd-or-system-v)))
|
|
|
3203 (reporter-submit-bug-report
|
|
|
3204 View-process-package-maintainer
|
|
|
3205 (concat View-process-package-name " " View-process-package-version)
|
|
|
3206 (list 'emacs-version
|
|
|
3207 'major-mode
|
|
|
3208 'View-process-buffer-name
|
|
|
3209 'View-process-header-buffer-name
|
|
|
3210 'View-process-sorter-and-filter
|
|
|
3211 'View-process-actual-sorter-and-filter
|
|
|
3212 'View-process-display-with-2-windows
|
|
|
3213 'View-process-hide-header
|
|
|
3214 'View-process-truncate-lines
|
|
|
3215 'View-process-motion-help
|
|
|
3216 'View-process-old-window-configuration
|
|
|
3217 'View-process-field-names
|
|
|
3218 'View-process-max-fields
|
|
|
3219 'View-process-output-start
|
|
|
3220 'View-process-output-end
|
|
|
3221 'View-process-header-start
|
|
|
3222 'View-process-header-end
|
|
|
3223 'View-process-host-names-and-system-types
|
|
|
3224 'View-process-remote-host
|
|
|
3225 'View-process-system-type
|
|
|
3226 'bsd-or-system-v
|
|
|
3227 'View-process-rsh-command
|
|
|
3228 'View-process-signal-command
|
|
|
3229 'View-process-status-command-switches-bsd
|
|
|
3230 'View-process-status-command-switches-system-v
|
|
|
3231 'View-process-status-last-command-switches
|
|
|
3232 'View-process-status-command
|
|
|
3233 'View-process-test-command
|
|
|
3234 'View-process-test-switches
|
|
|
3235 'View-process-uname-command
|
|
|
3236 'View-process-uname-switches
|
|
|
3237 )
|
|
|
3238 nil
|
|
|
3239 nil
|
|
|
3240 (concat
|
|
|
3241 "If it is possible, you should send this bug report from the buffer\n"
|
|
|
3242 "with the view process mode. Please answer the following questions.\n"
|
|
|
3243 "Which is the name of your system? \n"
|
|
|
3244 "Is your system a BSD Unix? \n"
|
|
|
3245 "Is your system a System V Unix? \n"
|
|
|
3246 "Describe your bug: "
|
|
|
3247 ))))
|
|
|
3248
|
|
|
3249 (defun View-process-display-version ()
|
|
|
3250 "Displays the current version of the mode."
|
|
|
3251 (interactive)
|
|
|
3252 (message "View Process Mode, %s, Author: Heiko Münkel."
|
|
|
3253 View-process-package-version))
|
|
|
3254
|
|
|
3255 (defun View-process-toggle-truncate-lines (&optional arg)
|
|
|
3256 "Change whether the lines in this buffer are truncated.
|
|
|
3257 With ARG, set `truncate-lines' to t, if ARG is positive.
|
|
|
3258 ARG is a prefix arg.
|
|
|
3259 It saves also the state of `truncate-lines' for the next
|
|
|
3260 view process command in `View-process-truncate-lines'.
|
|
|
3261 It truncates also the lines in the view process header buffer,
|
|
|
3262 if it is run in a view process mode buffer."
|
|
|
3263 (interactive "P")
|
|
|
3264 (if arg
|
|
|
3265 (if (>= (prefix-numeric-value arg) 0)
|
|
|
3266 (setq truncate-lines t)
|
|
|
3267 (setq truncate-lines nil))
|
|
|
3268 (if truncate-lines
|
|
|
3269 (setq truncate-lines nil)
|
|
|
3270 (setq truncate-lines t)))
|
|
|
3271 (setq View-process-truncate-lines truncate-lines)
|
|
|
3272 (setq-default View-process-truncate-lines truncate-lines)
|
|
|
3273 (if (and (eq major-mode 'View-process-mode)
|
|
|
3274 (or View-process-display-with-2-windows
|
|
|
3275 (get-buffer View-process-header-buffer-name)))
|
|
|
3276 (let ((buffer (current-buffer))
|
|
|
3277 (truncate truncate-lines))
|
|
|
3278 (set-buffer View-process-header-buffer-name)
|
|
|
3279 (setq truncate-lines truncate)
|
|
|
3280 (set-buffer buffer))))
|
|
|
3281
|
|
|
3282 (defun View-process-return-beginning-of-line ()
|
|
|
3283 "Returns the beginning of the current line.
|
|
|
3284 The point isn't changed."
|
|
|
3285 (save-excursion
|
|
|
3286 (beginning-of-line)
|
|
|
3287 (point)))
|
|
|
3288
|
|
|
3289 (defun View-process-return-end-of-line ()
|
|
|
3290 "Returns the end of the current line.
|
|
|
3291 The point isn't changed."
|
|
|
3292 (save-excursion
|
|
|
3293 (end-of-line)
|
|
|
3294 (point)))
|
|
|
3295
|
|
|
3296 (defun View-process-assoc-2th (key list)
|
|
|
3297 "Return non-nil if KEY is `equal' to the 2th of an element of LIST.
|
|
|
3298 The value is actually the element of LIST whose 2th is KEY."
|
|
|
3299 (cond ((not list) nil)
|
|
|
3300 ((equal (car (cdr (car list))) key) (car list))
|
|
|
3301 (t (View-process-assoc-2th key (cdr list)))))
|
|
|
3302
|
|
|
3303
|
|
|
3304 (defun View-process-replace-in-string (from-string
|
|
|
3305 to-string
|
|
|
3306 in-string
|
|
|
3307 &optional start)
|
|
|
3308 "Replace FROM-STRING with TO-STRING in IN-STRING.
|
|
|
3309 The optional argument START set the start position > 0.
|
|
|
3310 FROM-STRING is a regular expression."
|
|
|
3311 (setq start (or start 0))
|
|
|
3312 (let ((start-of-from-string (string-match from-string in-string start)))
|
|
|
3313 (if start-of-from-string
|
|
|
3314 (concat (substring in-string start start-of-from-string)
|
|
|
3315 to-string
|
|
|
3316 (View-process-replace-in-string from-string
|
|
|
3317 to-string
|
|
|
3318 in-string
|
|
|
3319 (match-end 0)))
|
|
|
3320 (substring in-string start))))
|
|
|
3321
|
|
|
3322
|
|
|
3323 (defun View-process-toggle-digit-bindings (&optional arg)
|
|
|
3324 "Change whether the digit keys sends signals to the processes.
|
|
|
3325 With ARG, set `View-process-digit-bindings-send-signal' to t,
|
|
|
3326 if ARG is positive. ARG is a prefix arg."
|
|
|
3327 (interactive "P")
|
|
|
3328 (if arg
|
|
|
3329 (if (>= (prefix-numeric-value arg) 0)
|
|
|
3330 (setq View-process-digit-bindings-send-signal t)
|
|
|
3331 (setq View-process-digit-bindings-send-signal nil))
|
|
|
3332 (if View-process-digit-bindings-send-signal
|
|
|
3333 (setq View-process-digit-bindings-send-signal nil)
|
|
|
3334 (setq View-process-digit-bindings-send-signal t)))
|
|
|
3335 (if View-process-digit-bindings-send-signal
|
|
|
3336 (progn
|
|
|
3337 (define-key View-process-mode-map "0"
|
|
|
3338 'undefined)
|
|
|
3339 (define-key View-process-mode-map "1"
|
|
|
3340 'View-process-send-key-as-signal-to-processes)
|
|
|
3341 (define-key View-process-mode-map "2"
|
|
|
3342 'View-process-send-key-as-signal-to-processes)
|
|
|
3343 (define-key View-process-mode-map "3"
|
|
|
3344 'View-process-send-key-as-signal-to-processes)
|
|
|
3345 (define-key View-process-mode-map "4"
|
|
|
3346 'View-process-send-key-as-signal-to-processes)
|
|
|
3347 (define-key View-process-mode-map "5"
|
|
|
3348 'View-process-send-key-as-signal-to-processes)
|
|
|
3349 (define-key View-process-mode-map "6"
|
|
|
3350 'View-process-send-key-as-signal-to-processes)
|
|
|
3351 (define-key View-process-mode-map "7"
|
|
|
3352 'View-process-send-key-as-signal-to-processes)
|
|
|
3353 (define-key View-process-mode-map "8"
|
|
|
3354 'View-process-send-key-as-signal-to-processes)
|
|
|
3355 (define-key View-process-mode-map "9"
|
|
|
3356 'View-process-send-key-as-signal-to-processes)
|
|
|
3357 )
|
|
|
3358 (define-key View-process-mode-map "0"
|
|
|
3359 'digit-argument)
|
|
|
3360 (define-key View-process-mode-map "1"
|
|
|
3361 'digit-argument)
|
|
|
3362 (define-key View-process-mode-map "2"
|
|
|
3363 'digit-argument)
|
|
|
3364 (define-key View-process-mode-map "3"
|
|
|
3365 'digit-argument)
|
|
|
3366 (define-key View-process-mode-map "4"
|
|
|
3367 'digit-argument)
|
|
|
3368 (define-key View-process-mode-map "5"
|
|
|
3369 'digit-argument)
|
|
|
3370 (define-key View-process-mode-map "6"
|
|
|
3371 'digit-argument)
|
|
|
3372 (define-key View-process-mode-map "7"
|
|
|
3373 'digit-argument)
|
|
|
3374 (define-key View-process-mode-map "8"
|
|
|
3375 'digit-argument)
|
|
|
3376 (define-key View-process-mode-map "9"
|
|
|
3377 'digit-argument)
|
|
|
3378 ))
|
|
|
3379
|
|
|
3380 (if View-process-digit-bindings-send-signal
|
|
|
3381 (View-process-toggle-digit-bindings 1)
|
|
|
3382 (View-process-toggle-digit-bindings -1))
|
|
|
3383
|
|
|
3384 (defun View-process-revert-buffer (&optional ignore-auto noconfirm)
|
|
|
3385 "Updates the view-process buffer with `View-process-status-update'."
|
|
|
3386 (View-process-status-update))
|
|
|
3387
|
|
|
3388
|
|
|
3389 ;;; Emacs version specific stuff
|
|
|
3390
|
|
|
3391 (if (View-process-xemacs-p)
|
|
|
3392 (require 'view-process-xemacs)
|
|
|
3393 (require 'view-process-emacs-19))
|
|
|
3394
|
|
|
3395
|
|
|
3396 ;;; face setting
|
|
|
3397
|
|
|
3398 (if (facep 'View-process-child-line-face)
|
|
|
3399 nil
|
|
|
3400 (make-face 'View-process-child-line-face)
|
|
|
3401 (if (View-process-search-color View-process-child-line-foreground)
|
|
|
3402 (set-face-foreground 'View-process-child-line-face
|
|
|
3403 (View-process-search-color
|
|
|
3404 View-process-child-line-foreground)))
|
|
|
3405 (if (View-process-search-color View-process-child-line-background)
|
|
|
3406 (set-face-background 'View-process-child-line-face
|
|
|
3407 (View-process-search-color
|
|
|
3408 View-process-child-line-background)))
|
|
|
3409 (set-face-font 'View-process-child-line-face
|
|
|
3410 View-process-child-line-font)
|
|
|
3411 (set-face-underline-p 'View-process-child-line-face
|
|
|
3412 View-process-child-line-underline-p))
|
|
|
3413
|
|
|
3414 (if (facep 'View-process-parent-line-face)
|
|
|
3415 nil
|
|
|
3416 (make-face 'View-process-parent-line-face)
|
|
|
3417 (if (View-process-search-color View-process-parent-line-foreground)
|
|
|
3418 (set-face-foreground 'View-process-parent-line-face
|
|
|
3419 (View-process-search-color
|
|
|
3420 View-process-parent-line-foreground)))
|
|
|
3421 (if (View-process-search-color View-process-parent-line-background)
|
|
|
3422 (set-face-background 'View-process-parent-line-face
|
|
|
3423 (View-process-search-color
|
|
|
3424 View-process-parent-line-background)))
|
|
|
3425 (set-face-font 'View-process-parent-line-face
|
|
|
3426 View-process-parent-line-font)
|
|
|
3427 (set-face-underline-p 'View-process-parent-line-face
|
|
|
3428 View-process-parent-line-underline-p))
|
|
|
3429
|
|
|
3430 (if (facep 'View-process-single-line-face)
|
|
|
3431 nil
|
|
|
3432 (make-face 'View-process-single-line-face)
|
|
|
3433 (if (View-process-search-color View-process-single-line-foreground)
|
|
|
3434 (set-face-foreground 'View-process-single-line-face
|
|
|
3435 (View-process-search-color
|
|
|
3436 View-process-single-line-foreground)))
|
|
|
3437 (if (View-process-search-color View-process-single-line-background)
|
|
|
3438 (set-face-background 'View-process-single-line-face
|
|
|
3439 (View-process-search-color
|
|
|
3440 View-process-single-line-background)))
|
|
|
3441 (set-face-font 'View-process-single-line-face
|
|
|
3442 View-process-single-line-font)
|
|
|
3443 (set-face-underline-p 'View-process-single-line-face
|
|
|
3444 View-process-single-line-underline-p))
|
|
|
3445
|
|
|
3446 (if (facep 'View-process-signaled-line-face)
|
|
|
3447 nil
|
|
|
3448 (make-face 'View-process-signaled-line-face)
|
|
|
3449 (if (View-process-search-color View-process-signaled-line-foreground)
|
|
|
3450 (set-face-foreground 'View-process-signaled-line-face
|
|
|
3451 (View-process-search-color
|
|
|
3452 View-process-signaled-line-foreground)))
|
|
|
3453 (if (View-process-search-color View-process-signaled-line-background)
|
|
|
3454 (set-face-background 'View-process-signaled-line-face
|
|
|
3455 (View-process-search-color
|
|
|
3456 View-process-signaled-line-background)))
|
|
|
3457 (set-face-font 'View-process-signaled-line-face
|
|
|
3458 View-process-signaled-line-font)
|
|
|
3459 (set-face-underline-p 'View-process-signaled-line-face
|
|
|
3460 View-process-signaled-line-underline-p))
|
|
|
3461
|
|
|
3462 (if (facep 'View-process-signal-line-face)
|
|
|
3463 nil
|
|
|
3464 (make-face 'View-process-signal-line-face)
|
|
|
3465 (if (View-process-search-color View-process-signal-line-foreground)
|
|
|
3466 (set-face-foreground 'View-process-signal-line-face
|
|
|
3467 (View-process-search-color
|
|
|
3468 View-process-signal-line-foreground)))
|
|
|
3469 (if (View-process-search-color View-process-signal-line-background)
|
|
|
3470 (set-face-background 'View-process-signal-line-face
|
|
|
3471 (View-process-search-color
|
|
|
3472 View-process-signal-line-background)))
|
|
|
3473 (set-face-font 'View-process-signal-line-face
|
|
|
3474 View-process-signal-line-font)
|
|
|
3475 (set-face-underline-p 'View-process-signal-line-face
|
|
|
3476 View-process-signal-line-underline-p))
|
|
|
3477
|
|
|
3478 (if (facep 'View-process-renice-line-face)
|
|
|
3479 nil
|
|
|
3480 (make-face 'View-process-renice-line-face)
|
|
|
3481 (if (View-process-search-color View-process-renice-line-foreground)
|
|
|
3482 (set-face-foreground 'View-process-renice-line-face
|
|
|
3483 (View-process-search-color
|
|
|
3484 View-process-renice-line-foreground)))
|
|
|
3485 (if (View-process-search-color View-process-renice-line-background)
|
|
|
3486 (set-face-background 'View-process-renice-line-face
|
|
|
3487 (View-process-search-color
|
|
|
3488 View-process-renice-line-background)))
|
|
|
3489 (set-face-font 'View-process-renice-line-face
|
|
|
3490 View-process-renice-line-font)
|
|
|
3491 (set-face-underline-p 'View-process-renice-line-face
|
|
|
3492 View-process-renice-line-underline-p))
|
|
|
3493
|
|
|
3494 (if (facep 'View-process-header-line-face)
|
|
|
3495 nil
|
|
|
3496 (make-face 'View-process-header-line-face)
|
|
|
3497 (if (View-process-search-color View-process-header-line-foreground)
|
|
|
3498 (set-face-foreground 'View-process-header-line-face
|
|
|
3499 (View-process-search-color
|
|
|
3500 View-process-header-line-foreground)))
|
|
|
3501 (if (View-process-search-color View-process-header-line-background)
|
|
|
3502 (set-face-background 'View-process-header-line-face
|
|
|
3503 (View-process-search-color
|
|
|
3504 View-process-header-line-background)))
|
|
|
3505 (set-face-font 'View-process-header-line-face
|
|
|
3506 View-process-header-line-font)
|
|
|
3507 (set-face-underline-p 'View-process-header-line-face
|
|
|
3508 View-process-header-line-underline-p))
|
|
|
3509
|
|
|
3510 (defun View-process-highlight-header-line ()
|
|
|
3511 "Highlights the headerline with the face `View-process-header-line-face'."
|
|
|
3512 (let ((extent
|
|
|
3513 (make-extent View-process-header-start View-process-header-end)
|
|
|
3514 ))
|
|
|
3515 (set-extent-face extent 'View-process-header-line-face)
|
|
|
3516 (set-extent-property extent 'duplicable t))
|
|
|
3517 )
|
|
|
3518
|
|
|
3519 ;;; A short cut for the View-process-status command
|
|
|
3520
|
|
|
3521 (defalias 'ps 'View-process-status)
|
|
|
3522
|
|
|
3523 ;;; view-process-mode.el ends here
|
