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: |
92d9ce48 RW |
31 | ;; - decompose ps(1) output into columns (for `proced-header-alist') |
32 | ;; How can we identify columns that may contain whitespace | |
33 | ;; and that can be either right or left justified? | |
34 | ;; Use a "grammar table"? | |
61548252 RW |
35 | ;; - sort the "cooked" values used in the output format fields |
36 | ;; if ps(1) doesn't support the requested sorting scheme | |
37e4d8ed | 37 | ;; - filter by user name or other criteria |
e6854b3f | 38 | ;; - automatic update of process list |
37e4d8ed RW |
39 | |
40 | ;;; Code: | |
41 | ||
42 | (defgroup proced nil | |
43 | "Proced mode." | |
44 | :group 'processes | |
45 | :group 'unix | |
46 | :prefix "proced-") | |
47 | ||
92d9ce48 RW |
48 | ;; FIXME: a better approach instead of PID-COLUMN would be based |
49 | ;; on `proced-header-alist' once we have a reliable scheme to set this variable | |
37e4d8ed | 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 | ||
92d9ce48 RW |
84 | (defcustom proced-command (if (zerop (user-real-uid)) "all" "user") |
85 | "Name of process listing. | |
86 | Must be the car of an element of `proced-command-alist'." | |
87 | :group 'proced | |
88 | :type '(string :tag "name")) | |
89 | (make-variable-buffer-local 'proced-command) | |
90 | ||
91 | ;; Should we incorporate in NAME that sorting can be done in ascending | |
92 | ;; or descending order? Then we couldn't associate NAME anymore with one | |
93 | ;; of the headers in the output of ps(1). | |
94 | ;; FIXME: A sorting scheme without options or with an option being a symbol | |
95 | ;; should be implemented in elisp | |
61548252 RW |
96 | (defcustom proced-sorting-schemes-alist |
97 | (cond ((memq system-type '(gnu gnu/linux)) ; GNU long options | |
98 | '(("%CPU" "--sort" "-pcpu") ; descending order | |
99 | ("%MEM" "--sort" "-pmem") ; descending order | |
100 | ("COMMAND" "--sort" "args") | |
101 | ("PID" "--sort" "pid") | |
102 | ("PGID,PID" "--sort" "pgid,pid") | |
103 | ("PPID,PID" "--sort" "ppid,pid") | |
104 | ("RSS" "--sort" "rss,pid") ; equal RSS's are rare | |
105 | ("STAT,PID" "--sort" "stat,pid") | |
106 | ("START" "--sort" "start_time") | |
107 | ("TIME" "--sort" "cputime") | |
108 | ("TTY,PID" "--sort" "tty,pid") | |
109 | ("UID,PID" "--sort" "uid,pid") | |
110 | ("USER,PID" "--sort" "user,pid") | |
111 | ("VSZ,PID" "--sort" "vsz,pid")))) | |
112 | "Alist of sorting schemes. | |
113 | Each element is a list (NAME OPTION1 OPTION2 ...). | |
92d9ce48 RW |
114 | NAME denotes the sorting scheme. It is the name of a header or a |
115 | comma-separated sequence of headers in the output of ps(1). | |
116 | OPTION1, OPTION2, ... are options defining the sorting scheme." | |
61548252 RW |
117 | :group 'proced |
118 | :type '(repeat (cons (string :tag "name") | |
119 | (repeat (string :tag "option"))))) | |
120 | ||
121 | (defcustom proced-sorting-scheme nil | |
122 | "Proced sorting type. | |
123 | Must be the car of an element of `proced-sorting-schemes-alist' or nil." | |
124 | :group 'proced | |
125 | :type `(choice ,@(append '((const nil)) ; sorting type may be nil | |
126 | (mapcar (lambda (item) | |
127 | (list 'const (car item))) | |
128 | proced-sorting-schemes-alist)))) | |
129 | (make-variable-buffer-local 'proced-sorting-scheme) | |
37e4d8ed | 130 | |
92d9ce48 RW |
131 | (defcustom proced-goal-header-re "\\b\\(CMD\\|COMMAND\\)\\b" |
132 | "If non-nil, regexp that defines the `proced-goal-column'." | |
37e4d8ed | 133 | :group 'proced |
92d9ce48 RW |
134 | :type '(choice (const :tag "none" nil) |
135 | (regexp :tag "regexp"))) | |
37e4d8ed | 136 | |
e6854b3f RW |
137 | (defcustom proced-signal-function 'signal-process |
138 | "Name of signal function. | |
139 | It can be an elisp function (usually `signal-process') or a string specifying | |
140 | the external command (usually \"kill\")." | |
37e4d8ed | 141 | :group 'proced |
e6854b3f RW |
142 | :type '(choice (function :tag "function") |
143 | (string :tag "command"))) | |
37e4d8ed RW |
144 | |
145 | (defcustom proced-signal-list | |
146 | '(("HUP (1. Hangup)") | |
147 | ("INT (2. Terminal interrupt)") | |
148 | ("QUIT (3. Terminal quit)") | |
149 | ("ABRT (6. Process abort)") | |
150 | ("KILL (9. Kill -- cannot be caught or ignored)") | |
151 | ("ALRM (14. Alarm Clock)") | |
152 | ("TERM (15. Termination)")) | |
153 | "List of signals, used for minibuffer completion." | |
154 | :group 'proced | |
155 | :type '(repeat (string :tag "signal"))) | |
156 | ||
92d9ce48 | 157 | ;; Internal variables |
37e4d8ed RW |
158 | (defvar proced-marker-char ?* ; the answer is 42 |
159 | "In proced, the current mark character.") | |
160 | ||
161 | ;; face and font-lock code taken from dired | |
162 | (defgroup proced-faces nil | |
163 | "Faces used by Proced." | |
164 | :group 'proced | |
165 | :group 'faces) | |
166 | ||
37e4d8ed RW |
167 | (defface proced-mark |
168 | '((t (:inherit font-lock-constant-face))) | |
169 | "Face used for proced marks." | |
170 | :group 'proced-faces) | |
171 | (defvar proced-mark-face 'proced-mark | |
172 | "Face name used for proced marks.") | |
173 | ||
174 | (defface proced-marked | |
175 | '((t (:inherit font-lock-warning-face))) | |
176 | "Face used for marked processes." | |
177 | :group 'proced-faces) | |
178 | (defvar proced-marked-face 'proced-marked | |
179 | "Face name used for marked processes.") | |
180 | ||
181 | (defvar proced-re-mark "^[^ \n]" | |
182 | "Regexp matching a marked line. | |
183 | Important: the match ends just after the marker.") | |
184 | ||
92d9ce48 RW |
185 | (defvar proced-goal-column nil |
186 | "Proced goal column. Initialized based on `proced-goal-header-re'.") | |
187 | (make-variable-buffer-local 'proced-goal-column) | |
37e4d8ed RW |
188 | |
189 | (defvar proced-font-lock-keywords | |
190 | (list | |
37e4d8ed RW |
191 | ;; |
192 | ;; Proced marks. | |
193 | (list proced-re-mark '(0 proced-mark-face)) | |
194 | ;; | |
195 | ;; Marked files. | |
196 | (list (concat "^[" (char-to-string proced-marker-char) "]") | |
92d9ce48 | 197 | '(".+" (proced-move-to-goal-column) nil (0 proced-marked-face))))) |
37e4d8ed RW |
198 | |
199 | (defvar proced-mode-map | |
200 | (let ((km (make-sparse-keymap))) | |
92d9ce48 RW |
201 | ;; moving |
202 | (define-key km " " 'proced-next-line) | |
203 | (define-key km "n" 'proced-next-line) | |
204 | (define-key km "p" 'proced-previous-line) | |
205 | (define-key km "\C-n" 'proced-next-line) | |
206 | (define-key km "\C-p" 'proced-previous-line) | |
207 | (define-key km "\C-?" 'proced-previous-line) | |
208 | (define-key km [down] 'proced-next-line) | |
209 | (define-key km [up] 'proced-previous-line) | |
210 | ;; marking | |
37e4d8ed RW |
211 | (define-key km "d" 'proced-mark) ; Dired compatibility |
212 | (define-key km "m" 'proced-mark) | |
37e4d8ed | 213 | (define-key km "u" 'proced-unmark) |
e6854b3f | 214 | (define-key km "\177" 'proced-unmark-backward) |
92d9ce48 | 215 | (define-key km "M" 'proced-mark-all) |
37e4d8ed | 216 | (define-key km "U" 'proced-unmark-all) |
e6854b3f | 217 | (define-key km "t" 'proced-toggle-marks) |
92d9ce48 | 218 | ;; sorting |
61548252 RW |
219 | (define-key km "sc" 'proced-sort-pcpu) |
220 | (define-key km "sm" 'proced-sort-pmem) | |
221 | (define-key km "sp" 'proced-sort-pid) | |
222 | (define-key km "ss" 'proced-sort-start) | |
223 | (define-key km "sS" 'proced-sort) | |
224 | (define-key km "st" 'proced-sort-time) | |
92d9ce48 RW |
225 | ;; operate |
226 | (define-key km "h" 'proced-hide-processes) | |
227 | (define-key km "x" 'proced-send-signal) ; Dired compatibility | |
228 | (define-key km "k" 'proced-send-signal) ; kill processes | |
229 | ;; misc | |
230 | (define-key km "l" 'proced-listing-type) | |
231 | (define-key km "g" 'revert-buffer) ; Dired compatibility | |
232 | (define-key km "h" 'describe-mode) | |
233 | (define-key km "?" 'proced-help) | |
234 | (define-key km "q" 'quit-window) | |
37e4d8ed RW |
235 | (define-key km [remap undo] 'proced-undo) |
236 | (define-key km [remap advertised-undo] 'proced-undo) | |
237 | km) | |
238 | "Keymap for proced commands") | |
239 | ||
240 | (easy-menu-define | |
241 | proced-menu proced-mode-map "Proced Menu" | |
242 | '("Proced" | |
243 | ["Mark" proced-mark t] | |
244 | ["Unmark" proced-unmark t] | |
245 | ["Mark All" proced-mark-all t] | |
246 | ["Unmark All" proced-unmark-all t] | |
e6854b3f RW |
247 | ["Toggle Marks" proced-unmark-all t] |
248 | "--" | |
61548252 RW |
249 | ["Sort" proced-sort t] |
250 | ["Sort by %CPU" proced-sort-pcpu (proced-sorting-scheme-p "%CPU")] | |
251 | ["Sort by %MEM" proced-sort-pmem (proced-sorting-scheme-p "%MEM")] | |
252 | ["Sort by PID" proced-sort-pid (proced-sorting-scheme-p "PID")] | |
253 | ["Sort by START" proced-sort-start (proced-sorting-scheme-p "START")] | |
254 | ["Sort by TIME" proced-sort-time (proced-sorting-scheme-p "TIME")] | |
255 | "--" | |
e6854b3f | 256 | ["Hide Marked Processes" proced-hide-processes t] |
37e4d8ed RW |
257 | "--" |
258 | ["Revert" revert-buffer t] | |
259 | ["Send signal" proced-send-signal t] | |
260 | ["Change listing" proced-listing-type t])) | |
261 | ||
262 | (defconst proced-help-string | |
263 | "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)" | |
264 | "Help string for proced.") | |
265 | ||
b9df5969 RW |
266 | (defvar proced-header-line nil |
267 | "Headers in Proced buffer as a string.") | |
268 | (make-variable-buffer-local 'proced-header-line) | |
269 | ||
92d9ce48 RW |
270 | (defvar proced-header-alist nil |
271 | "Alist of headers in Proced buffer. | |
272 | Each element is of the form (NAME START END JUSTIFY). | |
273 | NAME is name of header in the output of ps(1). | |
274 | START and END are column numbers starting from 0. | |
275 | END is t if there is no end column for that field. | |
276 | JUSTIFY is 'left or 'right for left or right-justified output of ps(1).") | |
277 | (make-variable-buffer-local 'proced-header-alist) | |
278 | ||
279 | (defvar proced-sorting-schemes-re nil | |
280 | "Regexp to match valid sorting schemes.") | |
281 | (make-variable-buffer-local 'proced-sorting-schemes-re) | |
282 | ||
283 | ;; helper functions | |
e6854b3f | 284 | (defun proced-marker-regexp () |
61548252 | 285 | "Return regexp matching `proced-marker-char'." |
92d9ce48 | 286 | ;; `proced-marker-char' must appear in column zero |
e6854b3f RW |
287 | (concat "^" (regexp-quote (char-to-string proced-marker-char)))) |
288 | ||
289 | (defun proced-success-message (action count) | |
61548252 | 290 | "Display success message for ACTION performed for COUNT processes." |
e6854b3f RW |
291 | (message "%s %s process%s" action count (if (= 1 count) "" "es"))) |
292 | ||
92d9ce48 RW |
293 | (defun proced-move-to-goal-column () |
294 | "Move to `proced-goal-column' if non-nil." | |
e6854b3f | 295 | (beginning-of-line) |
92d9ce48 RW |
296 | (if proced-goal-column |
297 | (forward-char proced-goal-column) | |
e6854b3f RW |
298 | (forward-char 2))) |
299 | ||
92d9ce48 RW |
300 | ;; FIXME: a better approach would be based on `proced-header-alist' |
301 | ;; once we have a reliable scheme to set this variable | |
e6854b3f | 302 | (defsubst proced-skip-regexp () |
92d9ce48 | 303 | "Regexp to skip in process listing to find PID column." |
e6854b3f RW |
304 | (apply 'concat (make-list (1- (nth 2 (assoc proced-command |
305 | proced-command-alist))) | |
306 | "\\s-+\\S-+"))) | |
307 | ||
079ba9b7 SM |
308 | (define-derived-mode proced-mode nil "Proced" |
309 | "Mode for displaying UNIX system processes and sending signals to them. | |
310 | Type \\[proced-mark-process] to mark a process for later commands. | |
311 | Type \\[proced-send-signal] to send signals to marked processes. | |
312 | ||
313 | \\{proced-mode-map}" | |
314 | (abbrev-mode 0) | |
315 | (auto-fill-mode 0) | |
316 | (setq buffer-read-only t | |
b9df5969 RW |
317 | truncate-lines t |
318 | header-line-format '(:eval (proced-header-line))) | |
319 | (add-hook 'post-command-hook 'force-mode-line-update nil t) | |
079ba9b7 SM |
320 | (set (make-local-variable 'revert-buffer-function) 'proced-revert) |
321 | (set (make-local-variable 'font-lock-defaults) | |
322 | '(proced-font-lock-keywords t nil nil beginning-of-line))) | |
323 | ||
324 | ;; Proced mode is suitable only for specially formatted data. | |
325 | (put 'proced-mode 'mode-class 'special) | |
326 | ||
327 | ;;;###autoload | |
328 | (defun proced (&optional arg) | |
e6854b3f | 329 | "Mode for displaying UNIX system processes and sending signals to them. |
37e4d8ed RW |
330 | Type \\[proced-mark-process] to mark a process for later commands. |
331 | Type \\[proced-send-signal] to send signals to marked processes. | |
332 | ||
333 | If invoked with optional ARG the window displaying the process | |
334 | information will be displayed but not selected. | |
335 | ||
336 | \\{proced-mode-map}" | |
337 | (interactive "P") | |
92d9ce48 | 338 | (let ((buffer (get-buffer-create "*Proced*")) new) |
61548252 | 339 | (set-buffer buffer) |
37e4d8ed | 340 | (setq new (zerop (buffer-size))) |
61548252 | 341 | (if new (proced-mode)) |
37e4d8ed RW |
342 | |
343 | (if (or new arg) | |
344 | (proced-update)) | |
345 | ||
346 | (if arg | |
61548252 RW |
347 | (display-buffer buffer) |
348 | (pop-to-buffer buffer) | |
37e4d8ed | 349 | (message (substitute-command-keys |
079ba9b7 | 350 | "type \\[quit-window] to quit, \\[proced-help] for help"))))) |
37e4d8ed | 351 | |
92d9ce48 RW |
352 | (defun proced-next-line (arg) |
353 | "Move down lines then position at `proced-goal-column'. | |
354 | Optional prefix ARG says how many lines to move; default is one line." | |
355 | (interactive "p") | |
27ab83ab | 356 | (forward-line arg) |
92d9ce48 RW |
357 | (proced-move-to-goal-column)) |
358 | ||
359 | (defun proced-previous-line (arg) | |
360 | "Move up lines then position at `proced-goal-column'. | |
361 | Optional prefix ARG says how many lines to move; default is one line." | |
362 | (interactive "p") | |
27ab83ab | 363 | (forward-line (- arg)) |
92d9ce48 RW |
364 | (proced-move-to-goal-column)) |
365 | ||
37e4d8ed RW |
366 | (defun proced-mark (&optional count) |
367 | "Mark the current (or next COUNT) processes." | |
368 | (interactive "p") | |
369 | (proced-do-mark t count)) | |
370 | ||
371 | (defun proced-unmark (&optional count) | |
372 | "Unmark the current (or next COUNT) processes." | |
373 | (interactive "p") | |
374 | (proced-do-mark nil count)) | |
375 | ||
e6854b3f RW |
376 | (defun proced-unmark-backward (&optional count) |
377 | "Unmark the previous (or COUNT previous) processes." | |
61548252 RW |
378 | ;; Analogous to `dired-unmark-backward', |
379 | ;; but `ibuffer-unmark-backward' behaves different. | |
e6854b3f RW |
380 | (interactive "p") |
381 | (proced-do-mark nil (- (or count 1)))) | |
382 | ||
37e4d8ed RW |
383 | (defun proced-do-mark (mark &optional count) |
384 | "Mark the current (or next ARG) processes using MARK." | |
385 | (or count (setq count 1)) | |
e6854b3f | 386 | (let ((backward (< count 0)) |
37e4d8ed | 387 | buffer-read-only) |
92d9ce48 RW |
388 | (setq count (1+ (if (<= 0 count) count |
389 | (min (1- (line-number-at-pos)) (abs count))))) | |
390 | (beginning-of-line) | |
391 | (while (not (or (zerop (setq count (1- count))) (eobp))) | |
392 | (proced-insert-mark mark backward)) | |
393 | (proced-move-to-goal-column))) | |
37e4d8ed RW |
394 | |
395 | (defun proced-mark-all () | |
396 | "Mark all processes." | |
397 | (interactive) | |
398 | (proced-do-mark-all t)) | |
399 | ||
400 | (defun proced-unmark-all () | |
401 | "Unmark all processes." | |
402 | (interactive) | |
403 | (proced-do-mark-all nil)) | |
404 | ||
405 | (defun proced-do-mark-all (mark) | |
406 | "Mark all processes using MARK." | |
e6854b3f RW |
407 | (let (buffer-read-only) |
408 | (save-excursion | |
92d9ce48 | 409 | (goto-char (point-min)) |
37e4d8ed | 410 | (while (not (eobp)) |
e6854b3f | 411 | (proced-insert-mark mark))))) |
37e4d8ed | 412 | |
e6854b3f RW |
413 | (defun proced-toggle-marks () |
414 | "Toggle marks: marked processes become unmarked, and vice versa." | |
415 | (interactive) | |
416 | (let ((mark-re (proced-marker-regexp)) | |
417 | buffer-read-only) | |
418 | (save-excursion | |
92d9ce48 | 419 | (goto-char (point-min)) |
e6854b3f RW |
420 | (while (not (eobp)) |
421 | (cond ((looking-at mark-re) | |
422 | (proced-insert-mark nil)) | |
423 | ((looking-at " ") | |
424 | (proced-insert-mark t)) | |
425 | (t | |
426 | (forward-line 1))))))) | |
427 | ||
428 | (defun proced-insert-mark (mark &optional backward) | |
429 | "If MARK is non-nil, insert `proced-marker-char'. | |
430 | If BACKWARD is non-nil, move one line backwards before inserting the mark. | |
431 | Otherwise move one line forward after inserting the mark." | |
432 | (if backward (forward-line -1)) | |
37e4d8ed RW |
433 | (insert (if mark proced-marker-char ?\s)) |
434 | (delete-char 1) | |
e6854b3f RW |
435 | (unless backward (forward-line))) |
436 | ||
437 | ;; Mostly analog of `dired-do-kill-lines'. | |
438 | ;; However, for negative args the target lines of `dired-do-kill-lines' | |
439 | ;; include the current line, whereas `dired-mark' for negative args operates | |
440 | ;; on the preceding lines. Here we are consistent with `dired-mark'. | |
441 | (defun proced-hide-processes (&optional arg quiet) | |
442 | "Hide marked processes. | |
443 | With prefix ARG, hide that many lines starting with the current line. | |
444 | \(A negative argument hides backward.) | |
445 | If QUIET is non-nil suppress status message. | |
446 | Returns count of hidden lines." | |
447 | (interactive "P") | |
448 | (let ((mark-re (proced-marker-regexp)) | |
449 | (count 0) | |
450 | buffer-read-only) | |
451 | (save-excursion | |
452 | (if arg | |
453 | ;; Hide ARG lines starting with the current line. | |
92d9ce48 RW |
454 | (delete-region (line-beginning-position) |
455 | (save-excursion | |
456 | (if (<= 0 arg) | |
457 | (setq count (- arg (forward-line arg))) | |
458 | (setq count (min (1- (line-number-at-pos)) | |
459 | (abs arg))) | |
460 | (forward-line (- count))) | |
461 | (point))) | |
e6854b3f | 462 | ;; Hide marked lines |
e6854b3f RW |
463 | (while (and (not (eobp)) |
464 | (re-search-forward mark-re nil t)) | |
465 | (delete-region (match-beginning 0) | |
466 | (save-excursion (forward-line) (point))) | |
467 | (setq count (1+ count))))) | |
92d9ce48 RW |
468 | (unless (zerop count) (proced-move-to-goal-column)) |
469 | (unless quiet (proced-success-message "Hid" count)) | |
e6854b3f | 470 | count)) |
37e4d8ed RW |
471 | |
472 | (defun proced-listing-type (command) | |
473 | "Select `proced' listing type COMMAND from `proced-command-alist'." | |
474 | (interactive | |
475 | (list (completing-read "Listing type: " proced-command-alist nil t))) | |
476 | (setq proced-command command) | |
477 | (proced-update)) | |
478 | ||
92d9ce48 RW |
479 | ;; adopted from `ruler-mode-space' |
480 | (defsubst proced-header-space (width) | |
481 | "Return a single space string of WIDTH times the normal character width." | |
482 | (propertize " " 'display (list 'space :width width))) | |
483 | ||
b9df5969 RW |
484 | ;; header line: code inspired by `ruler-mode-ruler' |
485 | (defun proced-header-line () | |
486 | "Return header line for Proced buffer." | |
82305b1a | 487 | (list (propertize " " 'display '(space :align-to 0)) |
b9df5969 RW |
488 | (replace-regexp-in-string |
489 | "%" "%%" (substring proced-header-line (window-hscroll))))) | |
490 | ||
37e4d8ed RW |
491 | (defun proced-update (&optional quiet) |
492 | "Update the `proced' process information. Preserves point and marks." | |
e6854b3f | 493 | ;; This is the main function that generates and updates the process listing. |
37e4d8ed RW |
494 | (interactive) |
495 | (or quiet (message "Updating process information...")) | |
61548252 | 496 | (let* ((command (cadr (assoc proced-command proced-command-alist))) |
37e4d8ed RW |
497 | (regexp (concat (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\)")) |
498 | (old-pos (if (save-excursion | |
499 | (beginning-of-line) | |
500 | (looking-at (concat "^[* ]" regexp))) | |
501 | (cons (match-string-no-properties 1) | |
502 | (current-column)))) | |
92d9ce48 | 503 | buffer-read-only mp-list) |
37e4d8ed RW |
504 | (goto-char (point-min)) |
505 | ;; remember marked processes (whatever the mark was) | |
506 | (while (re-search-forward (concat "^\\(\\S-\\)" regexp) nil t) | |
507 | (push (cons (match-string-no-properties 2) | |
92d9ce48 | 508 | (match-string-no-properties 1)) mp-list)) |
37e4d8ed RW |
509 | ;; generate new listing |
510 | (erase-buffer) | |
61548252 RW |
511 | (apply 'call-process (car command) nil t nil |
512 | (append (cdr command) (cdr (assoc proced-sorting-scheme | |
513 | proced-sorting-schemes-alist)))) | |
37e4d8ed RW |
514 | (goto-char (point-min)) |
515 | (while (not (eobp)) | |
516 | (insert " ") | |
517 | (forward-line)) | |
518 | ;; (delete-trailing-whitespace) | |
519 | (goto-char (point-min)) | |
520 | (while (re-search-forward "[ \t\r]+$" nil t) | |
521 | (delete-region (match-beginning 0) (match-end 0))) | |
37e4d8ed | 522 | (goto-char (point-min)) |
92d9ce48 | 523 | (let ((lep (line-end-position))) |
b9df5969 | 524 | (setq proced-header-line (buffer-substring-no-properties (point) lep)) |
92d9ce48 RW |
525 | (setq proced-header-alist nil) |
526 | ;; FIXME: handle left/right justification properly | |
527 | (while (re-search-forward "\\([^ \t\n]+\\)[ \t]*\\($\\)?" lep t) | |
528 | (push (list (match-string-no-properties 1) | |
529 | ;; take the column number starting from zero | |
82305b1a SM |
530 | (- (match-beginning 0) (point-min)) |
531 | (or (not (not (match-beginning 2))) | |
532 | (- (match-end 0) (point-min))) | |
92d9ce48 RW |
533 | 'left) |
534 | proced-header-alist))) | |
535 | (let ((temp (regexp-opt (mapcar 'car proced-header-alist) t))) | |
536 | (setq proced-sorting-schemes-re | |
537 | (concat "\\`" temp "\\(," temp "\\)*\\'"))) | |
538 | ;; remove header line from ps(1) output | |
539 | (goto-char (point-min)) | |
540 | (delete-region (point) | |
541 | (save-excursion (forward-line) (point))) | |
542 | (set-buffer-modified-p nil) | |
543 | ;; set `proced-goal-column' | |
544 | (if proced-goal-header-re | |
545 | (let ((hlist proced-header-alist) header) | |
546 | (while (setq header (pop hlist)) | |
547 | (if (string-match proced-goal-header-re (car header)) | |
548 | (setq proced-goal-column | |
549 | (if (eq 'left (nth 3 header)) | |
550 | (nth 1 header) (nth 2 header)) | |
551 | hlist nil))))) | |
37e4d8ed | 552 | ;; restore process marks |
92d9ce48 | 553 | (if mp-list |
37e4d8ed | 554 | (save-excursion |
92d9ce48 | 555 | (goto-char (point-min)) |
37e4d8ed RW |
556 | (let (mark) |
557 | (while (re-search-forward (concat "^" regexp) nil t) | |
92d9ce48 | 558 | (if (setq mark (assoc (match-string-no-properties 1) mp-list)) |
37e4d8ed RW |
559 | (save-excursion |
560 | (beginning-of-line) | |
561 | (insert (cdr mark)) | |
562 | (delete-char 1))))))) | |
563 | ;; restore buffer position (if possible) | |
92d9ce48 | 564 | (goto-char (point-min)) |
37e4d8ed RW |
565 | (if (and old-pos |
566 | (re-search-forward | |
567 | (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos) "\\>") | |
568 | nil t)) | |
569 | (progn | |
570 | (beginning-of-line) | |
571 | (forward-char (cdr old-pos))) | |
92d9ce48 | 572 | (proced-move-to-goal-column)) |
61548252 | 573 | ;; update modeline |
92d9ce48 RW |
574 | ;; Does the long mode-name clutter the modeline? |
575 | (setq mode-name (concat "Proced: " proced-command | |
576 | (if proced-sorting-scheme | |
577 | (concat " by " proced-sorting-scheme) | |
578 | ""))) | |
61548252 RW |
579 | (force-mode-line-update) |
580 | ;; done | |
37e4d8ed RW |
581 | (or quiet (input-pending-p) |
582 | (message "Updating process information...done.")))) | |
583 | ||
584 | (defun proced-revert (&rest args) | |
585 | "Analog of `revert-buffer'." | |
586 | (proced-update)) | |
587 | ||
e6854b3f | 588 | ;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer' |
92d9ce48 RW |
589 | ;; and move it to window.el so that proced and ibuffer can easily use it, too? |
590 | ;; What about functions like `appt-disp-window' that use | |
591 | ;; `shrink-window-if-larger-than-buffer'? | |
37e4d8ed RW |
592 | (autoload 'dired-pop-to-buffer "dired") |
593 | ||
594 | (defun proced-send-signal (&optional signal) | |
595 | "Send a SIGNAL to the marked processes. | |
596 | SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. | |
597 | If SIGNAL is nil display marked processes and query interactively for SIGNAL." | |
598 | (interactive) | |
e6854b3f RW |
599 | (let ((regexp (concat (proced-marker-regexp) |
600 | (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$")) | |
92d9ce48 | 601 | process-list) |
37e4d8ed RW |
602 | ;; collect marked processes |
603 | (save-excursion | |
604 | (goto-char (point-min)) | |
605 | (while (re-search-forward regexp nil t) | |
606 | (push (cons (match-string-no-properties 1) | |
e6854b3f RW |
607 | ;; How much info should we collect here? Would it be |
608 | ;; better to collect only the PID (to avoid ambiguities) | |
609 | ;; and the command name? | |
37e4d8ed | 610 | (substring (match-string-no-properties 0) 2)) |
92d9ce48 RW |
611 | process-list))) |
612 | (setq process-list (nreverse process-list)) | |
613 | (if (not process-list) | |
37e4d8ed RW |
614 | (message "No processes marked") |
615 | (unless signal | |
616 | ;; Display marked processes (code taken from `dired-mark-pop-up'). | |
37e4d8ed | 617 | (let ((bufname " *Marked Processes*") |
b9df5969 | 618 | (header proced-header-line)) ; inherit header line |
37e4d8ed | 619 | (with-current-buffer (get-buffer-create bufname) |
92d9ce48 | 620 | (setq truncate-lines t |
b9df5969 RW |
621 | proced-header-line header |
622 | header-line-format '(:eval (proced-header-line))) | |
623 | (add-hook 'post-command-hook 'force-mode-line-update nil t) | |
37e4d8ed | 624 | (erase-buffer) |
92d9ce48 RW |
625 | (dolist (process process-list) |
626 | (insert " " (cdr process) "\n")) | |
37e4d8ed RW |
627 | (save-window-excursion |
628 | (dired-pop-to-buffer bufname) ; all we need | |
629 | (let* ((completion-ignore-case t) | |
92d9ce48 | 630 | (pnum (if (= 1 (length process-list)) |
e6854b3f | 631 | "1 process" |
92d9ce48 | 632 | (format "%d processes" (length process-list)))) |
37e4d8ed RW |
633 | ;; The following is an ugly hack. Is there a better way |
634 | ;; to help people like me to remember the signals and | |
635 | ;; their meanings? | |
e6854b3f RW |
636 | (tmp (completing-read (concat "Send signal [" pnum |
637 | "] (default TERM): ") | |
37e4d8ed RW |
638 | proced-signal-list |
639 | nil nil nil nil "TERM"))) | |
640 | (setq signal (if (string-match "^\\(\\S-+\\)\\s-" tmp) | |
641 | (match-string 1 tmp) tmp)))))) | |
642 | ;; send signal | |
e6854b3f RW |
643 | (let ((count 0) |
644 | err-list) | |
645 | (if (functionp proced-signal-function) | |
646 | ;; use built-in `signal-process' | |
647 | (let ((signal (if (stringp signal) | |
648 | (if (string-match "\\`[0-9]+\\'" signal) | |
649 | (string-to-number signal) | |
650 | (make-symbol signal)) | |
651 | signal))) ; number | |
92d9ce48 | 652 | (dolist (process process-list) |
e6854b3f RW |
653 | (if (zerop (funcall |
654 | proced-signal-function | |
655 | (string-to-number (car process)) signal)) | |
52434c81 RW |
656 | (setq count (1+ count)) |
657 | (push (cdr process) err-list)))) | |
e6854b3f RW |
658 | ;; use external system call |
659 | (let ((signal (concat "-" (if (numberp signal) | |
660 | (number-to-string signal) signal)))) | |
92d9ce48 | 661 | (dolist (process process-list) |
e6854b3f RW |
662 | (if (zerop (call-process |
663 | proced-signal-function nil 0 nil | |
664 | signal (car process))) | |
52434c81 RW |
665 | (setq count (1+ count)) |
666 | (push (cdr process) err-list))))) | |
e6854b3f RW |
667 | (if err-list |
668 | ;; FIXME: that's not enough to display the errors. | |
669 | (message "%s: %s" signal err-list) | |
670 | (proced-success-message "Sent signal to" count))) | |
671 | ;; final clean-up | |
37e4d8ed RW |
672 | (run-hooks 'proced-after-send-signal-hook))))) |
673 | ||
674 | (defun proced-help () | |
675 | "Provide help for the `proced' user." | |
676 | (interactive) | |
677 | (if (eq last-command 'proced-help) | |
678 | (describe-mode) | |
679 | (message proced-help-string))) | |
680 | ||
681 | (defun proced-undo () | |
682 | "Undo in a proced buffer. | |
683 | This doesn't recover killed processes, it just undoes changes in the proced | |
684 | buffer. You can use it to recover marks." | |
685 | (interactive) | |
686 | (let (buffer-read-only) | |
687 | (undo)) | |
92d9ce48 | 688 | (message "Change in Proced buffer undone. |
37e4d8ed RW |
689 | Killed processes cannot be recovered by Emacs.")) |
690 | ||
61548252 RW |
691 | ;;; Sorting |
692 | (defun proced-sort (scheme) | |
693 | "Sort Proced buffer using SCHEME. | |
694 | When called interactively, an empty string means nil, i.e., no sorting." | |
695 | (interactive | |
696 | (list (let* ((completion-ignore-case t) | |
92d9ce48 RW |
697 | ;; restrict completion list to applicable sorting schemes |
698 | (completion-list | |
699 | (apply 'append | |
700 | (mapcar (lambda (x) | |
701 | (if (string-match proced-sorting-schemes-re | |
702 | (car x)) | |
703 | (list (car x)))) | |
704 | proced-sorting-schemes-alist))) | |
61548252 | 705 | (scheme (completing-read "Sorting type: " |
92d9ce48 | 706 | completion-list nil t))) |
61548252 RW |
707 | (if (string= "" scheme) nil scheme)))) |
708 | (if (proced-sorting-scheme-p scheme) | |
709 | (progn | |
710 | (setq proced-sorting-scheme scheme) | |
711 | (proced-update)) | |
92d9ce48 | 712 | (error "Proced sorting scheme %s not applicable" scheme))) |
61548252 RW |
713 | |
714 | (defun proced-sorting-scheme-p (scheme) | |
715 | "Return non-nil if SCHEME is an applicable sorting scheme. | |
716 | SCHEME must be a string or nil." | |
717 | (or (not scheme) | |
92d9ce48 RW |
718 | (and (string-match proced-sorting-schemes-re scheme) |
719 | (assoc scheme proced-sorting-schemes-alist)))) | |
61548252 RW |
720 | |
721 | (defun proced-sort-pcpu () | |
722 | "Sort Proced buffer by percentage CPU time (%CPU)." | |
723 | (interactive) | |
724 | (proced-sort "%CPU")) | |
725 | ||
726 | (defun proced-sort-pmem () | |
727 | "Sort Proced buffer by percentage memory usage (%MEM)." | |
728 | (interactive) | |
729 | (proced-sort "%MEM")) | |
730 | ||
731 | (defun proced-sort-pid () | |
732 | "Sort Proced buffer by PID." | |
733 | (interactive) | |
734 | (proced-sort "PID")) | |
735 | ||
736 | (defun proced-sort-start () | |
737 | "Sort Proced buffer by time the command started (START)." | |
738 | (interactive) | |
739 | (proced-sort "START")) | |
740 | ||
741 | (defun proced-sort-time () | |
742 | "Sort Proced buffer by cumulative CPU time (TIME)." | |
743 | (interactive) | |
744 | (proced-sort "TIME")) | |
745 | ||
37e4d8ed RW |
746 | (provide 'proced) |
747 | ||
dfab9988 | 748 | ;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af |
37e4d8ed | 749 | ;;; proced.el ends here. |