Commit | Line | Data |
---|---|---|
e6854b3f | 1 | ;;; proced.el --- operate on system processes like dired |
37e4d8ed | 2 | |
1ba1a8b9 RW |
3 | ;; Copyright (C) 2008 Free Software Foundation, Inc. |
4 | ||
37e4d8ed | 5 | ;; Author: Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> |
37e4d8ed RW |
6 | ;; Keywords: Processes, Unix |
7 | ||
1ba1a8b9 RW |
8 | ;; This file is part of GNU Emacs. |
9 | ||
eb3fa2cf | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
1ba1a8b9 | 11 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
37e4d8ed | 14 | |
1ba1a8b9 RW |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
37e4d8ed RW |
19 | |
20 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
37e4d8ed RW |
22 | |
23 | ;;; Commentary: | |
24 | ||
e6854b3f RW |
25 | ;; Proced makes an Emacs buffer containing a listing of the current system |
26 | ;; processes (using ps(1)). You can use the normal Emacs commands | |
27 | ;; to move around in this buffer, and special Proced commands to operate | |
28 | ;; on the processes listed. | |
37e4d8ed | 29 | ;; |
e6854b3f | 30 | ;; To do: |
61548252 RW |
31 | ;; - sort the "cooked" values used in the output format fields |
32 | ;; if ps(1) doesn't support the requested sorting scheme | |
37e4d8ed | 33 | ;; - filter by user name or other criteria |
e6854b3f | 34 | ;; - automatic update of process list |
37e4d8ed RW |
35 | |
36 | ;;; Code: | |
37 | ||
38 | (defgroup proced nil | |
39 | "Proced mode." | |
40 | :group 'processes | |
41 | :group 'unix | |
42 | :prefix "proced-") | |
43 | ||
44 | (defcustom proced-procname-column-regexp "\\b\\(CMD\\|COMMAND\\)\\b" | |
45 | "If non-nil, regexp that defines the `proced-procname-column'." | |
46 | :group 'proced | |
47 | :type '(choice (const :tag "none" nil) | |
48 | (regexp :tag "regexp"))) | |
49 | ||
50 | (defcustom proced-command-alist | |
61548252 | 51 | (cond ((memq system-type '(berkeley-unix)) |
37e4d8ed RW |
52 | '(("user" ("ps" "-uxgww") 2) |
53 | ("user-running" ("ps" "-uxrgww") 2) | |
54 | ("all" ("ps" "-auxgww") 2) | |
55 | ("all-running" ("ps" "-auxrgww") 2))) | |
61548252 | 56 | ((memq system-type '(gnu gnu/linux)) ; BSD syntax |
37e4d8ed RW |
57 | `(("user" ("ps" "uxwww") 2) |
58 | ("user-running" ("ps" "uxrwww") 2) | |
59 | ("all" ("ps" "auxwww") 2) | |
60 | ("all-running" ("ps" "auxrwww") 2) | |
61 | ("emacs" ("ps" "--pid" ,(number-to-string (emacs-pid)) | |
62 | "--ppid" ,(number-to-string (emacs-pid)) | |
63 | "uwww") 2))) | |
f5b00811 SM |
64 | ((memq system-type '(darwin)) |
65 | `(("user" ("ps" "-u" ,(number-to-string (user-uid))) 2) | |
66 | ("all" ("ps" "-Au") 2))) | |
61548252 | 67 | (t ; standard UNIX syntax; doesn't allow to list running processes only |
37e4d8ed RW |
68 | `(("user" ("ps" "-fu" ,(number-to-string (user-uid))) 2) |
69 | ("all" ("ps" "-ef") 2)))) | |
70 | "Alist of commands to get list of processes. | |
e6854b3f | 71 | Each element has the form (NAME COMMAND PID-COLUMN). |
37e4d8ed RW |
72 | NAME is a shorthand name to select the type of listing. |
73 | COMMAND is a list (COMMAND-NAME ARG1 ARG2 ...), | |
74 | where COMMAND-NAME is the command to generate the listing (usually \"ps\"). | |
75 | ARG1, ARG2, ... are arguments passed to COMMAND-NAME to generate | |
76 | a particular listing. These arguments differ under various operating systems. | |
e6854b3f | 77 | PID-COLUMN is the column number (starting from 1) of the process ID." |
37e4d8ed RW |
78 | :group 'proced |
79 | :type '(repeat (group (string :tag "name") | |
80 | (cons (string :tag "command") | |
81 | (repeat (string :tag "option"))) | |
61548252 RW |
82 | (integer :tag "PID column")))) |
83 | ||
84 | ;; Should we incorporate in NAME if sorting is done in descending order? | |
85 | (defcustom proced-sorting-schemes-alist | |
86 | (cond ((memq system-type '(gnu gnu/linux)) ; GNU long options | |
87 | '(("%CPU" "--sort" "-pcpu") ; descending order | |
88 | ("%MEM" "--sort" "-pmem") ; descending order | |
89 | ("COMMAND" "--sort" "args") | |
90 | ("PID" "--sort" "pid") | |
91 | ("PGID,PID" "--sort" "pgid,pid") | |
92 | ("PPID,PID" "--sort" "ppid,pid") | |
93 | ("RSS" "--sort" "rss,pid") ; equal RSS's are rare | |
94 | ("STAT,PID" "--sort" "stat,pid") | |
95 | ("START" "--sort" "start_time") | |
96 | ("TIME" "--sort" "cputime") | |
97 | ("TTY,PID" "--sort" "tty,pid") | |
98 | ("UID,PID" "--sort" "uid,pid") | |
99 | ("USER,PID" "--sort" "user,pid") | |
100 | ("VSZ,PID" "--sort" "vsz,pid")))) | |
101 | "Alist of sorting schemes. | |
102 | Each element is a list (NAME OPTION1 OPTION2 ...). | |
103 | NAME denotes the sorting scheme and OPTION1, OPTION2, ... are options | |
104 | defining the sorting scheme." | |
105 | :group 'proced | |
106 | :type '(repeat (cons (string :tag "name") | |
107 | (repeat (string :tag "option"))))) | |
108 | ||
109 | (defcustom proced-sorting-scheme nil | |
110 | "Proced sorting type. | |
111 | Must be the car of an element of `proced-sorting-schemes-alist' or nil." | |
112 | :group 'proced | |
113 | :type `(choice ,@(append '((const nil)) ; sorting type may be nil | |
114 | (mapcar (lambda (item) | |
115 | (list 'const (car item))) | |
116 | proced-sorting-schemes-alist)))) | |
117 | (make-variable-buffer-local 'proced-sorting-scheme) | |
37e4d8ed RW |
118 | |
119 | (defcustom proced-command (if (zerop (user-real-uid)) "all" "user") | |
120 | "Name of process listing. | |
121 | Must be the car of an element of `proced-command-alist'." | |
122 | :group 'proced | |
123 | :type '(string :tag "name")) | |
e6854b3f | 124 | (make-variable-buffer-local 'proced-command) |
37e4d8ed | 125 | |
e6854b3f RW |
126 | (defcustom proced-signal-function 'signal-process |
127 | "Name of signal function. | |
128 | It can be an elisp function (usually `signal-process') or a string specifying | |
129 | the external command (usually \"kill\")." | |
37e4d8ed | 130 | :group 'proced |
e6854b3f RW |
131 | :type '(choice (function :tag "function") |
132 | (string :tag "command"))) | |
37e4d8ed RW |
133 | |
134 | (defcustom proced-signal-list | |
135 | '(("HUP (1. Hangup)") | |
136 | ("INT (2. Terminal interrupt)") | |
137 | ("QUIT (3. Terminal quit)") | |
138 | ("ABRT (6. Process abort)") | |
139 | ("KILL (9. Kill -- cannot be caught or ignored)") | |
140 | ("ALRM (14. Alarm Clock)") | |
141 | ("TERM (15. Termination)")) | |
142 | "List of signals, used for minibuffer completion." | |
143 | :group 'proced | |
144 | :type '(repeat (string :tag "signal"))) | |
145 | ||
146 | (defvar proced-marker-char ?* ; the answer is 42 | |
147 | "In proced, the current mark character.") | |
148 | ||
149 | ;; face and font-lock code taken from dired | |
150 | (defgroup proced-faces nil | |
151 | "Faces used by Proced." | |
152 | :group 'proced | |
153 | :group 'faces) | |
154 | ||
155 | (defface proced-header | |
156 | '((t (:inherit font-lock-type-face))) | |
157 | "Face used for proced headers." | |
158 | :group 'proced-faces) | |
159 | (defvar proced-header-face 'proced-header | |
160 | "Face name used for proced headers.") | |
161 | ||
162 | (defface proced-mark | |
163 | '((t (:inherit font-lock-constant-face))) | |
164 | "Face used for proced marks." | |
165 | :group 'proced-faces) | |
166 | (defvar proced-mark-face 'proced-mark | |
167 | "Face name used for proced marks.") | |
168 | ||
169 | (defface proced-marked | |
170 | '((t (:inherit font-lock-warning-face))) | |
171 | "Face used for marked processes." | |
172 | :group 'proced-faces) | |
173 | (defvar proced-marked-face 'proced-marked | |
174 | "Face name used for marked processes.") | |
175 | ||
176 | (defvar proced-re-mark "^[^ \n]" | |
177 | "Regexp matching a marked line. | |
178 | Important: the match ends just after the marker.") | |
179 | ||
180 | (defvar proced-header-regexp "\\`.*$" | |
181 | "Regexp matching a header line.") | |
182 | ||
183 | (defvar proced-procname-column nil | |
184 | "Proced command column. | |
185 | Initialized based on `proced-procname-column-regexp'.") | |
e6854b3f | 186 | (make-variable-buffer-local 'proced-procname-column) |
37e4d8ed RW |
187 | |
188 | (defvar proced-font-lock-keywords | |
189 | (list | |
190 | ;; | |
191 | ;; Process listing headers. | |
192 | (list proced-header-regexp '(0 proced-header-face)) | |
193 | ;; | |
194 | ;; Proced marks. | |
195 | (list proced-re-mark '(0 proced-mark-face)) | |
196 | ;; | |
197 | ;; Marked files. | |
198 | (list (concat "^[" (char-to-string proced-marker-char) "]") | |
199 | '(".+" (proced-move-to-procname) nil (0 proced-marked-face))))) | |
200 | ||
201 | (defvar proced-mode-map | |
202 | (let ((km (make-sparse-keymap))) | |
203 | (define-key km " " 'next-line) | |
204 | (define-key km "n" 'next-line) | |
205 | (define-key km "p" 'previous-line) | |
206 | (define-key km "\C-?" 'previous-line) | |
207 | (define-key km "h" 'describe-mode) | |
208 | (define-key km "?" 'proced-help) | |
209 | (define-key km "d" 'proced-mark) ; Dired compatibility | |
210 | (define-key km "m" 'proced-mark) | |
211 | (define-key km "M" 'proced-mark-all) | |
37e4d8ed | 212 | (define-key km "u" 'proced-unmark) |
e6854b3f | 213 | (define-key km "\177" 'proced-unmark-backward) |
37e4d8ed | 214 | (define-key km "U" 'proced-unmark-all) |
e6854b3f RW |
215 | (define-key km "t" 'proced-toggle-marks) |
216 | (define-key km "h" 'proced-hide-processes) | |
37e4d8ed RW |
217 | (define-key km "x" 'proced-send-signal) ; Dired compatibility |
218 | (define-key km "k" 'proced-send-signal) ; kill processes | |
219 | (define-key km "l" 'proced-listing-type) | |
e6854b3f RW |
220 | (define-key km "g" 'revert-buffer) ; Dired compatibility |
221 | (define-key km "q" 'quit-window) | |
61548252 RW |
222 | (define-key km "sc" 'proced-sort-pcpu) |
223 | (define-key km "sm" 'proced-sort-pmem) | |
224 | (define-key km "sp" 'proced-sort-pid) | |
225 | (define-key km "ss" 'proced-sort-start) | |
226 | (define-key km "sS" 'proced-sort) | |
227 | (define-key km "st" 'proced-sort-time) | |
37e4d8ed RW |
228 | (define-key km [remap undo] 'proced-undo) |
229 | (define-key km [remap advertised-undo] 'proced-undo) | |
230 | km) | |
231 | "Keymap for proced commands") | |
232 | ||
233 | (easy-menu-define | |
234 | proced-menu proced-mode-map "Proced Menu" | |
235 | '("Proced" | |
236 | ["Mark" proced-mark t] | |
237 | ["Unmark" proced-unmark t] | |
238 | ["Mark All" proced-mark-all t] | |
239 | ["Unmark All" proced-unmark-all t] | |
e6854b3f RW |
240 | ["Toggle Marks" proced-unmark-all t] |
241 | "--" | |
61548252 RW |
242 | ["Sort" proced-sort t] |
243 | ["Sort by %CPU" proced-sort-pcpu (proced-sorting-scheme-p "%CPU")] | |
244 | ["Sort by %MEM" proced-sort-pmem (proced-sorting-scheme-p "%MEM")] | |
245 | ["Sort by PID" proced-sort-pid (proced-sorting-scheme-p "PID")] | |
246 | ["Sort by START" proced-sort-start (proced-sorting-scheme-p "START")] | |
247 | ["Sort by TIME" proced-sort-time (proced-sorting-scheme-p "TIME")] | |
248 | "--" | |
e6854b3f | 249 | ["Hide Marked Processes" proced-hide-processes t] |
37e4d8ed RW |
250 | "--" |
251 | ["Revert" revert-buffer t] | |
252 | ["Send signal" proced-send-signal t] | |
253 | ["Change listing" proced-listing-type t])) | |
254 | ||
255 | (defconst proced-help-string | |
256 | "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)" | |
257 | "Help string for proced.") | |
258 | ||
e6854b3f | 259 | (defun proced-marker-regexp () |
61548252 | 260 | "Return regexp matching `proced-marker-char'." |
e6854b3f RW |
261 | (concat "^" (regexp-quote (char-to-string proced-marker-char)))) |
262 | ||
263 | (defun proced-success-message (action count) | |
61548252 | 264 | "Display success message for ACTION performed for COUNT processes." |
e6854b3f RW |
265 | (message "%s %s process%s" action count (if (= 1 count) "" "es"))) |
266 | ||
267 | (defun proced-move-to-procname () | |
268 | "Move to the beginning of the process name on the current line. | |
269 | Return the position of the beginning of the process name, or nil if none found." | |
270 | (beginning-of-line) | |
271 | (if proced-procname-column | |
272 | (forward-char proced-procname-column) | |
273 | (forward-char 2))) | |
274 | ||
275 | (defsubst proced-skip-regexp () | |
276 | "Regexp to skip in process listing." | |
277 | (apply 'concat (make-list (1- (nth 2 (assoc proced-command | |
278 | proced-command-alist))) | |
279 | "\\s-+\\S-+"))) | |
280 | ||
079ba9b7 SM |
281 | (define-derived-mode proced-mode nil "Proced" |
282 | "Mode for displaying UNIX system processes and sending signals to them. | |
283 | Type \\[proced-mark-process] to mark a process for later commands. | |
284 | Type \\[proced-send-signal] to send signals to marked processes. | |
285 | ||
286 | \\{proced-mode-map}" | |
287 | (abbrev-mode 0) | |
288 | (auto-fill-mode 0) | |
289 | (setq buffer-read-only t | |
290 | truncate-lines t) | |
291 | (set (make-local-variable 'revert-buffer-function) 'proced-revert) | |
292 | (set (make-local-variable 'font-lock-defaults) | |
293 | '(proced-font-lock-keywords t nil nil beginning-of-line))) | |
294 | ||
295 | ;; Proced mode is suitable only for specially formatted data. | |
296 | (put 'proced-mode 'mode-class 'special) | |
297 | ||
298 | ;;;###autoload | |
299 | (defun proced (&optional arg) | |
e6854b3f | 300 | "Mode for displaying UNIX system processes and sending signals to them. |
37e4d8ed RW |
301 | Type \\[proced-mark-process] to mark a process for later commands. |
302 | Type \\[proced-send-signal] to send signals to marked processes. | |
303 | ||
304 | If invoked with optional ARG the window displaying the process | |
305 | information will be displayed but not selected. | |
306 | ||
307 | \\{proced-mode-map}" | |
308 | (interactive "P") | |
61548252 RW |
309 | (let ((buffer (get-buffer-create "*Process Info*")) new) |
310 | (set-buffer buffer) | |
37e4d8ed | 311 | (setq new (zerop (buffer-size))) |
61548252 | 312 | (if new (proced-mode)) |
37e4d8ed RW |
313 | |
314 | (if (or new arg) | |
315 | (proced-update)) | |
316 | ||
317 | (if arg | |
61548252 RW |
318 | (display-buffer buffer) |
319 | (pop-to-buffer buffer) | |
37e4d8ed | 320 | (message (substitute-command-keys |
079ba9b7 | 321 | "type \\[quit-window] to quit, \\[proced-help] for help"))))) |
37e4d8ed | 322 | |
37e4d8ed RW |
323 | (defun proced-mark (&optional count) |
324 | "Mark the current (or next COUNT) processes." | |
325 | (interactive "p") | |
326 | (proced-do-mark t count)) | |
327 | ||
328 | (defun proced-unmark (&optional count) | |
329 | "Unmark the current (or next COUNT) processes." | |
330 | (interactive "p") | |
331 | (proced-do-mark nil count)) | |
332 | ||
e6854b3f RW |
333 | (defun proced-unmark-backward (&optional count) |
334 | "Unmark the previous (or COUNT previous) processes." | |
61548252 RW |
335 | ;; Analogous to `dired-unmark-backward', |
336 | ;; but `ibuffer-unmark-backward' behaves different. | |
e6854b3f RW |
337 | (interactive "p") |
338 | (proced-do-mark nil (- (or count 1)))) | |
339 | ||
37e4d8ed RW |
340 | (defun proced-do-mark (mark &optional count) |
341 | "Mark the current (or next ARG) processes using MARK." | |
342 | (or count (setq count 1)) | |
e6854b3f | 343 | (let ((backward (< count 0)) |
37e4d8ed RW |
344 | (line (line-number-at-pos)) |
345 | buffer-read-only) | |
346 | ;; do nothing in the first line | |
347 | (unless (= line 1) | |
e6854b3f RW |
348 | (setq count (1+ (if (<= 0 count) count |
349 | (min (- line 2) (abs count))))) | |
37e4d8ed RW |
350 | (beginning-of-line) |
351 | (while (not (or (zerop (setq count (1- count))) (eobp))) | |
e6854b3f | 352 | (proced-insert-mark mark backward)) |
37e4d8ed RW |
353 | (proced-move-to-procname)))) |
354 | ||
355 | (defun proced-mark-all () | |
356 | "Mark all processes." | |
357 | (interactive) | |
358 | (proced-do-mark-all t)) | |
359 | ||
360 | (defun proced-unmark-all () | |
361 | "Unmark all processes." | |
362 | (interactive) | |
363 | (proced-do-mark-all nil)) | |
364 | ||
365 | (defun proced-do-mark-all (mark) | |
366 | "Mark all processes using MARK." | |
e6854b3f RW |
367 | (let (buffer-read-only) |
368 | (save-excursion | |
37e4d8ed RW |
369 | (goto-line 2) |
370 | (while (not (eobp)) | |
e6854b3f | 371 | (proced-insert-mark mark))))) |
37e4d8ed | 372 | |
e6854b3f RW |
373 | (defun proced-toggle-marks () |
374 | "Toggle marks: marked processes become unmarked, and vice versa." | |
375 | (interactive) | |
376 | (let ((mark-re (proced-marker-regexp)) | |
377 | buffer-read-only) | |
378 | (save-excursion | |
379 | (goto-line 2) | |
380 | (while (not (eobp)) | |
381 | (cond ((looking-at mark-re) | |
382 | (proced-insert-mark nil)) | |
383 | ((looking-at " ") | |
384 | (proced-insert-mark t)) | |
385 | (t | |
386 | (forward-line 1))))))) | |
387 | ||
388 | (defun proced-insert-mark (mark &optional backward) | |
389 | "If MARK is non-nil, insert `proced-marker-char'. | |
390 | If BACKWARD is non-nil, move one line backwards before inserting the mark. | |
391 | Otherwise move one line forward after inserting the mark." | |
392 | (if backward (forward-line -1)) | |
37e4d8ed RW |
393 | (insert (if mark proced-marker-char ?\s)) |
394 | (delete-char 1) | |
e6854b3f RW |
395 | (unless backward (forward-line))) |
396 | ||
397 | ;; Mostly analog of `dired-do-kill-lines'. | |
398 | ;; However, for negative args the target lines of `dired-do-kill-lines' | |
399 | ;; include the current line, whereas `dired-mark' for negative args operates | |
400 | ;; on the preceding lines. Here we are consistent with `dired-mark'. | |
401 | (defun proced-hide-processes (&optional arg quiet) | |
402 | "Hide marked processes. | |
403 | With prefix ARG, hide that many lines starting with the current line. | |
404 | \(A negative argument hides backward.) | |
405 | If QUIET is non-nil suppress status message. | |
406 | Returns count of hidden lines." | |
407 | (interactive "P") | |
408 | (let ((mark-re (proced-marker-regexp)) | |
409 | (count 0) | |
410 | buffer-read-only) | |
411 | (save-excursion | |
412 | (if arg | |
413 | ;; Hide ARG lines starting with the current line. | |
414 | (let ((line (line-number-at-pos))) | |
415 | ;; do nothing in the first line | |
416 | (unless (= line 1) | |
417 | (delete-region (line-beginning-position) | |
418 | (save-excursion | |
419 | (if (<= 0 arg) | |
420 | (setq count (- arg (forward-line arg))) | |
421 | (setq count (min (- line 2) (abs arg))) | |
422 | (forward-line (- count))) | |
423 | (point))))) | |
424 | ;; Hide marked lines | |
425 | (goto-line 2) | |
426 | (while (and (not (eobp)) | |
427 | (re-search-forward mark-re nil t)) | |
428 | (delete-region (match-beginning 0) | |
429 | (save-excursion (forward-line) (point))) | |
430 | (setq count (1+ count))))) | |
431 | (unless (zerop count) (proced-move-to-procname)) | |
432 | (unless quiet | |
433 | (proced-success-message "Hid" count)) | |
434 | count)) | |
37e4d8ed RW |
435 | |
436 | (defun proced-listing-type (command) | |
437 | "Select `proced' listing type COMMAND from `proced-command-alist'." | |
438 | (interactive | |
439 | (list (completing-read "Listing type: " proced-command-alist nil t))) | |
440 | (setq proced-command command) | |
441 | (proced-update)) | |
442 | ||
37e4d8ed RW |
443 | (defun proced-update (&optional quiet) |
444 | "Update the `proced' process information. Preserves point and marks." | |
e6854b3f | 445 | ;; This is the main function that generates and updates the process listing. |
37e4d8ed RW |
446 | (interactive) |
447 | (or quiet (message "Updating process information...")) | |
61548252 | 448 | (let* ((command (cadr (assoc proced-command proced-command-alist))) |
37e4d8ed RW |
449 | (regexp (concat (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\)")) |
450 | (old-pos (if (save-excursion | |
451 | (beginning-of-line) | |
452 | (looking-at (concat "^[* ]" regexp))) | |
453 | (cons (match-string-no-properties 1) | |
454 | (current-column)))) | |
455 | buffer-read-only plist) | |
456 | (goto-char (point-min)) | |
457 | ;; remember marked processes (whatever the mark was) | |
458 | (while (re-search-forward (concat "^\\(\\S-\\)" regexp) nil t) | |
459 | (push (cons (match-string-no-properties 2) | |
460 | (match-string-no-properties 1)) plist)) | |
461 | ;; generate new listing | |
462 | (erase-buffer) | |
61548252 RW |
463 | (apply 'call-process (car command) nil t nil |
464 | (append (cdr command) (cdr (assoc proced-sorting-scheme | |
465 | proced-sorting-schemes-alist)))) | |
37e4d8ed RW |
466 | (goto-char (point-min)) |
467 | (while (not (eobp)) | |
468 | (insert " ") | |
469 | (forward-line)) | |
470 | ;; (delete-trailing-whitespace) | |
471 | (goto-char (point-min)) | |
472 | (while (re-search-forward "[ \t\r]+$" nil t) | |
473 | (delete-region (match-beginning 0) (match-end 0))) | |
e6854b3f | 474 | (set-buffer-modified-p nil) |
37e4d8ed RW |
475 | ;; set `proced-procname-column' |
476 | (goto-char (point-min)) | |
477 | (and proced-procname-column-regexp | |
478 | (re-search-forward proced-procname-column-regexp nil t) | |
479 | (setq proced-procname-column (1- (match-beginning 0)))) | |
37e4d8ed RW |
480 | ;; restore process marks |
481 | (if plist | |
482 | (save-excursion | |
483 | (goto-line 2) | |
484 | (let (mark) | |
485 | (while (re-search-forward (concat "^" regexp) nil t) | |
486 | (if (setq mark (assoc (match-string-no-properties 1) plist)) | |
487 | (save-excursion | |
488 | (beginning-of-line) | |
489 | (insert (cdr mark)) | |
490 | (delete-char 1))))))) | |
491 | ;; restore buffer position (if possible) | |
492 | (goto-line 2) | |
493 | (if (and old-pos | |
494 | (re-search-forward | |
495 | (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos) "\\>") | |
496 | nil t)) | |
497 | (progn | |
498 | (beginning-of-line) | |
499 | (forward-char (cdr old-pos))) | |
500 | (proced-move-to-procname)) | |
61548252 RW |
501 | ;; update modeline |
502 | (setq mode-name (if proced-sorting-scheme | |
503 | (concat "Proced by " proced-sorting-scheme) | |
504 | "Proced")) | |
505 | (force-mode-line-update) | |
506 | ;; done | |
37e4d8ed RW |
507 | (or quiet (input-pending-p) |
508 | (message "Updating process information...done.")))) | |
509 | ||
510 | (defun proced-revert (&rest args) | |
511 | "Analog of `revert-buffer'." | |
512 | (proced-update)) | |
513 | ||
e6854b3f RW |
514 | ;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer' |
515 | ;; and move it to simple.el so that proced and ibuffer can easily use it, too? | |
37e4d8ed RW |
516 | (autoload 'dired-pop-to-buffer "dired") |
517 | ||
518 | (defun proced-send-signal (&optional signal) | |
519 | "Send a SIGNAL to the marked processes. | |
520 | SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. | |
521 | If SIGNAL is nil display marked processes and query interactively for SIGNAL." | |
522 | (interactive) | |
e6854b3f RW |
523 | (let ((regexp (concat (proced-marker-regexp) |
524 | (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$")) | |
37e4d8ed RW |
525 | plist) |
526 | ;; collect marked processes | |
527 | (save-excursion | |
528 | (goto-char (point-min)) | |
529 | (while (re-search-forward regexp nil t) | |
530 | (push (cons (match-string-no-properties 1) | |
e6854b3f RW |
531 | ;; How much info should we collect here? Would it be |
532 | ;; better to collect only the PID (to avoid ambiguities) | |
533 | ;; and the command name? | |
37e4d8ed RW |
534 | (substring (match-string-no-properties 0) 2)) |
535 | plist))) | |
61548252 | 536 | (setq plist (nreverse plist)) |
37e4d8ed RW |
537 | (if (not plist) |
538 | (message "No processes marked") | |
539 | (unless signal | |
540 | ;; Display marked processes (code taken from `dired-mark-pop-up'). | |
37e4d8ed RW |
541 | (let ((bufname " *Marked Processes*") |
542 | (header (save-excursion | |
543 | (goto-char (+ 2 (point-min))) | |
544 | (buffer-substring-no-properties | |
545 | (point) (line-end-position))))) | |
546 | (with-current-buffer (get-buffer-create bufname) | |
547 | (setq truncate-lines t) | |
548 | (erase-buffer) | |
549 | (insert header "\n") | |
550 | (dolist (proc plist) | |
551 | (insert (cdr proc) "\n")) | |
552 | (save-window-excursion | |
553 | (dired-pop-to-buffer bufname) ; all we need | |
554 | (let* ((completion-ignore-case t) | |
e6854b3f RW |
555 | (pnum (if (= 1 (length plist)) |
556 | "1 process" | |
557 | (format "%d processes" (length plist)))) | |
37e4d8ed RW |
558 | ;; The following is an ugly hack. Is there a better way |
559 | ;; to help people like me to remember the signals and | |
560 | ;; their meanings? | |
e6854b3f RW |
561 | (tmp (completing-read (concat "Send signal [" pnum |
562 | "] (default TERM): ") | |
37e4d8ed RW |
563 | proced-signal-list |
564 | nil nil nil nil "TERM"))) | |
565 | (setq signal (if (string-match "^\\(\\S-+\\)\\s-" tmp) | |
566 | (match-string 1 tmp) tmp)))))) | |
567 | ;; send signal | |
e6854b3f RW |
568 | (let ((count 0) |
569 | err-list) | |
570 | (if (functionp proced-signal-function) | |
571 | ;; use built-in `signal-process' | |
572 | (let ((signal (if (stringp signal) | |
573 | (if (string-match "\\`[0-9]+\\'" signal) | |
574 | (string-to-number signal) | |
575 | (make-symbol signal)) | |
576 | signal))) ; number | |
577 | (dolist (process plist) | |
578 | (if (zerop (funcall | |
579 | proced-signal-function | |
580 | (string-to-number (car process)) signal)) | |
52434c81 RW |
581 | (setq count (1+ count)) |
582 | (push (cdr process) err-list)))) | |
e6854b3f RW |
583 | ;; use external system call |
584 | (let ((signal (concat "-" (if (numberp signal) | |
585 | (number-to-string signal) signal)))) | |
586 | (dolist (process plist) | |
587 | (if (zerop (call-process | |
588 | proced-signal-function nil 0 nil | |
589 | signal (car process))) | |
52434c81 RW |
590 | (setq count (1+ count)) |
591 | (push (cdr process) err-list))))) | |
e6854b3f RW |
592 | (if err-list |
593 | ;; FIXME: that's not enough to display the errors. | |
594 | (message "%s: %s" signal err-list) | |
595 | (proced-success-message "Sent signal to" count))) | |
596 | ;; final clean-up | |
37e4d8ed RW |
597 | (run-hooks 'proced-after-send-signal-hook))))) |
598 | ||
599 | (defun proced-help () | |
600 | "Provide help for the `proced' user." | |
601 | (interactive) | |
602 | (if (eq last-command 'proced-help) | |
603 | (describe-mode) | |
604 | (message proced-help-string))) | |
605 | ||
606 | (defun proced-undo () | |
607 | "Undo in a proced buffer. | |
608 | This doesn't recover killed processes, it just undoes changes in the proced | |
609 | buffer. You can use it to recover marks." | |
610 | (interactive) | |
611 | (let (buffer-read-only) | |
612 | (undo)) | |
613 | (message "Change in proced buffer undone. | |
614 | Killed processes cannot be recovered by Emacs.")) | |
615 | ||
61548252 RW |
616 | ;;; Sorting |
617 | (defun proced-sort (scheme) | |
618 | "Sort Proced buffer using SCHEME. | |
619 | When called interactively, an empty string means nil, i.e., no sorting." | |
620 | (interactive | |
621 | (list (let* ((completion-ignore-case t) | |
622 | (scheme (completing-read "Sorting type: " | |
623 | proced-sorting-schemes-alist nil t))) | |
624 | (if (string= "" scheme) nil scheme)))) | |
625 | (if (proced-sorting-scheme-p scheme) | |
626 | (progn | |
627 | (setq proced-sorting-scheme scheme) | |
628 | (proced-update)) | |
629 | (error "Proced sorting scheme %s undefined" scheme))) | |
630 | ||
631 | (defun proced-sorting-scheme-p (scheme) | |
632 | "Return non-nil if SCHEME is an applicable sorting scheme. | |
633 | SCHEME must be a string or nil." | |
634 | (or (not scheme) | |
635 | (assoc scheme proced-sorting-schemes-alist))) | |
636 | ||
637 | (defun proced-sort-pcpu () | |
638 | "Sort Proced buffer by percentage CPU time (%CPU)." | |
639 | (interactive) | |
640 | (proced-sort "%CPU")) | |
641 | ||
642 | (defun proced-sort-pmem () | |
643 | "Sort Proced buffer by percentage memory usage (%MEM)." | |
644 | (interactive) | |
645 | (proced-sort "%MEM")) | |
646 | ||
647 | (defun proced-sort-pid () | |
648 | "Sort Proced buffer by PID." | |
649 | (interactive) | |
650 | (proced-sort "PID")) | |
651 | ||
652 | (defun proced-sort-start () | |
653 | "Sort Proced buffer by time the command started (START)." | |
654 | (interactive) | |
655 | (proced-sort "START")) | |
656 | ||
657 | (defun proced-sort-time () | |
658 | "Sort Proced buffer by cumulative CPU time (TIME)." | |
659 | (interactive) | |
660 | (proced-sort "TIME")) | |
661 | ||
37e4d8ed RW |
662 | (provide 'proced) |
663 | ||
dfab9988 | 664 | ;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af |
37e4d8ed | 665 | ;;; proced.el ends here. |