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 | ||
92d9ce48 RW |
266 | (defvar proced-header-alist nil |
267 | "Alist of headers in Proced buffer. | |
268 | Each element is of the form (NAME START END JUSTIFY). | |
269 | NAME is name of header in the output of ps(1). | |
270 | START and END are column numbers starting from 0. | |
271 | END is t if there is no end column for that field. | |
272 | JUSTIFY is 'left or 'right for left or right-justified output of ps(1).") | |
273 | (make-variable-buffer-local 'proced-header-alist) | |
274 | ||
275 | (defvar proced-sorting-schemes-re nil | |
276 | "Regexp to match valid sorting schemes.") | |
277 | (make-variable-buffer-local 'proced-sorting-schemes-re) | |
278 | ||
279 | ;; helper functions | |
e6854b3f | 280 | (defun proced-marker-regexp () |
61548252 | 281 | "Return regexp matching `proced-marker-char'." |
92d9ce48 | 282 | ;; `proced-marker-char' must appear in column zero |
e6854b3f RW |
283 | (concat "^" (regexp-quote (char-to-string proced-marker-char)))) |
284 | ||
285 | (defun proced-success-message (action count) | |
61548252 | 286 | "Display success message for ACTION performed for COUNT processes." |
e6854b3f RW |
287 | (message "%s %s process%s" action count (if (= 1 count) "" "es"))) |
288 | ||
92d9ce48 RW |
289 | (defun proced-move-to-goal-column () |
290 | "Move to `proced-goal-column' if non-nil." | |
e6854b3f | 291 | (beginning-of-line) |
92d9ce48 RW |
292 | (if proced-goal-column |
293 | (forward-char proced-goal-column) | |
e6854b3f RW |
294 | (forward-char 2))) |
295 | ||
92d9ce48 RW |
296 | ;; FIXME: a better approach would be based on `proced-header-alist' |
297 | ;; once we have a reliable scheme to set this variable | |
e6854b3f | 298 | (defsubst proced-skip-regexp () |
92d9ce48 | 299 | "Regexp to skip in process listing to find PID column." |
e6854b3f RW |
300 | (apply 'concat (make-list (1- (nth 2 (assoc proced-command |
301 | proced-command-alist))) | |
302 | "\\s-+\\S-+"))) | |
303 | ||
079ba9b7 SM |
304 | (define-derived-mode proced-mode nil "Proced" |
305 | "Mode for displaying UNIX system processes and sending signals to them. | |
306 | Type \\[proced-mark-process] to mark a process for later commands. | |
307 | Type \\[proced-send-signal] to send signals to marked processes. | |
308 | ||
309 | \\{proced-mode-map}" | |
310 | (abbrev-mode 0) | |
311 | (auto-fill-mode 0) | |
312 | (setq buffer-read-only t | |
313 | truncate-lines t) | |
314 | (set (make-local-variable 'revert-buffer-function) 'proced-revert) | |
315 | (set (make-local-variable 'font-lock-defaults) | |
316 | '(proced-font-lock-keywords t nil nil beginning-of-line))) | |
317 | ||
318 | ;; Proced mode is suitable only for specially formatted data. | |
319 | (put 'proced-mode 'mode-class 'special) | |
320 | ||
321 | ;;;###autoload | |
322 | (defun proced (&optional arg) | |
e6854b3f | 323 | "Mode for displaying UNIX system processes and sending signals to them. |
37e4d8ed RW |
324 | Type \\[proced-mark-process] to mark a process for later commands. |
325 | Type \\[proced-send-signal] to send signals to marked processes. | |
326 | ||
327 | If invoked with optional ARG the window displaying the process | |
328 | information will be displayed but not selected. | |
329 | ||
330 | \\{proced-mode-map}" | |
331 | (interactive "P") | |
92d9ce48 | 332 | (let ((buffer (get-buffer-create "*Proced*")) new) |
61548252 | 333 | (set-buffer buffer) |
37e4d8ed | 334 | (setq new (zerop (buffer-size))) |
61548252 | 335 | (if new (proced-mode)) |
37e4d8ed RW |
336 | |
337 | (if (or new arg) | |
338 | (proced-update)) | |
339 | ||
340 | (if arg | |
61548252 RW |
341 | (display-buffer buffer) |
342 | (pop-to-buffer buffer) | |
37e4d8ed | 343 | (message (substitute-command-keys |
079ba9b7 | 344 | "type \\[quit-window] to quit, \\[proced-help] for help"))))) |
37e4d8ed | 345 | |
92d9ce48 RW |
346 | (defun proced-next-line (arg) |
347 | "Move down lines then position at `proced-goal-column'. | |
348 | Optional prefix ARG says how many lines to move; default is one line." | |
349 | (interactive "p") | |
350 | (next-line arg) | |
351 | (proced-move-to-goal-column)) | |
352 | ||
353 | (defun proced-previous-line (arg) | |
354 | "Move up lines then position at `proced-goal-column'. | |
355 | Optional prefix ARG says how many lines to move; default is one line." | |
356 | (interactive "p") | |
357 | (previous-line arg) | |
358 | (proced-move-to-goal-column)) | |
359 | ||
37e4d8ed RW |
360 | (defun proced-mark (&optional count) |
361 | "Mark the current (or next COUNT) processes." | |
362 | (interactive "p") | |
363 | (proced-do-mark t count)) | |
364 | ||
365 | (defun proced-unmark (&optional count) | |
366 | "Unmark the current (or next COUNT) processes." | |
367 | (interactive "p") | |
368 | (proced-do-mark nil count)) | |
369 | ||
e6854b3f RW |
370 | (defun proced-unmark-backward (&optional count) |
371 | "Unmark the previous (or COUNT previous) processes." | |
61548252 RW |
372 | ;; Analogous to `dired-unmark-backward', |
373 | ;; but `ibuffer-unmark-backward' behaves different. | |
e6854b3f RW |
374 | (interactive "p") |
375 | (proced-do-mark nil (- (or count 1)))) | |
376 | ||
37e4d8ed RW |
377 | (defun proced-do-mark (mark &optional count) |
378 | "Mark the current (or next ARG) processes using MARK." | |
379 | (or count (setq count 1)) | |
e6854b3f | 380 | (let ((backward (< count 0)) |
37e4d8ed | 381 | buffer-read-only) |
92d9ce48 RW |
382 | (setq count (1+ (if (<= 0 count) count |
383 | (min (1- (line-number-at-pos)) (abs count))))) | |
384 | (beginning-of-line) | |
385 | (while (not (or (zerop (setq count (1- count))) (eobp))) | |
386 | (proced-insert-mark mark backward)) | |
387 | (proced-move-to-goal-column))) | |
37e4d8ed RW |
388 | |
389 | (defun proced-mark-all () | |
390 | "Mark all processes." | |
391 | (interactive) | |
392 | (proced-do-mark-all t)) | |
393 | ||
394 | (defun proced-unmark-all () | |
395 | "Unmark all processes." | |
396 | (interactive) | |
397 | (proced-do-mark-all nil)) | |
398 | ||
399 | (defun proced-do-mark-all (mark) | |
400 | "Mark all processes using MARK." | |
e6854b3f RW |
401 | (let (buffer-read-only) |
402 | (save-excursion | |
92d9ce48 | 403 | (goto-char (point-min)) |
37e4d8ed | 404 | (while (not (eobp)) |
e6854b3f | 405 | (proced-insert-mark mark))))) |
37e4d8ed | 406 | |
e6854b3f RW |
407 | (defun proced-toggle-marks () |
408 | "Toggle marks: marked processes become unmarked, and vice versa." | |
409 | (interactive) | |
410 | (let ((mark-re (proced-marker-regexp)) | |
411 | buffer-read-only) | |
412 | (save-excursion | |
92d9ce48 | 413 | (goto-char (point-min)) |
e6854b3f RW |
414 | (while (not (eobp)) |
415 | (cond ((looking-at mark-re) | |
416 | (proced-insert-mark nil)) | |
417 | ((looking-at " ") | |
418 | (proced-insert-mark t)) | |
419 | (t | |
420 | (forward-line 1))))))) | |
421 | ||
422 | (defun proced-insert-mark (mark &optional backward) | |
423 | "If MARK is non-nil, insert `proced-marker-char'. | |
424 | If BACKWARD is non-nil, move one line backwards before inserting the mark. | |
425 | Otherwise move one line forward after inserting the mark." | |
426 | (if backward (forward-line -1)) | |
37e4d8ed RW |
427 | (insert (if mark proced-marker-char ?\s)) |
428 | (delete-char 1) | |
e6854b3f RW |
429 | (unless backward (forward-line))) |
430 | ||
431 | ;; Mostly analog of `dired-do-kill-lines'. | |
432 | ;; However, for negative args the target lines of `dired-do-kill-lines' | |
433 | ;; include the current line, whereas `dired-mark' for negative args operates | |
434 | ;; on the preceding lines. Here we are consistent with `dired-mark'. | |
435 | (defun proced-hide-processes (&optional arg quiet) | |
436 | "Hide marked processes. | |
437 | With prefix ARG, hide that many lines starting with the current line. | |
438 | \(A negative argument hides backward.) | |
439 | If QUIET is non-nil suppress status message. | |
440 | Returns count of hidden lines." | |
441 | (interactive "P") | |
442 | (let ((mark-re (proced-marker-regexp)) | |
443 | (count 0) | |
444 | buffer-read-only) | |
445 | (save-excursion | |
446 | (if arg | |
447 | ;; Hide ARG lines starting with the current line. | |
92d9ce48 RW |
448 | (delete-region (line-beginning-position) |
449 | (save-excursion | |
450 | (if (<= 0 arg) | |
451 | (setq count (- arg (forward-line arg))) | |
452 | (setq count (min (1- (line-number-at-pos)) | |
453 | (abs arg))) | |
454 | (forward-line (- count))) | |
455 | (point))) | |
e6854b3f | 456 | ;; Hide marked lines |
e6854b3f RW |
457 | (while (and (not (eobp)) |
458 | (re-search-forward mark-re nil t)) | |
459 | (delete-region (match-beginning 0) | |
460 | (save-excursion (forward-line) (point))) | |
461 | (setq count (1+ count))))) | |
92d9ce48 RW |
462 | (unless (zerop count) (proced-move-to-goal-column)) |
463 | (unless quiet (proced-success-message "Hid" count)) | |
e6854b3f | 464 | count)) |
37e4d8ed RW |
465 | |
466 | (defun proced-listing-type (command) | |
467 | "Select `proced' listing type COMMAND from `proced-command-alist'." | |
468 | (interactive | |
469 | (list (completing-read "Listing type: " proced-command-alist nil t))) | |
470 | (setq proced-command command) | |
471 | (proced-update)) | |
472 | ||
92d9ce48 RW |
473 | ;; adopted from `ruler-mode-space' |
474 | (defsubst proced-header-space (width) | |
475 | "Return a single space string of WIDTH times the normal character width." | |
476 | (propertize " " 'display (list 'space :width width))) | |
477 | ||
37e4d8ed RW |
478 | (defun proced-update (&optional quiet) |
479 | "Update the `proced' process information. Preserves point and marks." | |
e6854b3f | 480 | ;; This is the main function that generates and updates the process listing. |
37e4d8ed RW |
481 | (interactive) |
482 | (or quiet (message "Updating process information...")) | |
61548252 | 483 | (let* ((command (cadr (assoc proced-command proced-command-alist))) |
37e4d8ed RW |
484 | (regexp (concat (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\)")) |
485 | (old-pos (if (save-excursion | |
486 | (beginning-of-line) | |
487 | (looking-at (concat "^[* ]" regexp))) | |
488 | (cons (match-string-no-properties 1) | |
489 | (current-column)))) | |
92d9ce48 | 490 | buffer-read-only mp-list) |
37e4d8ed RW |
491 | (goto-char (point-min)) |
492 | ;; remember marked processes (whatever the mark was) | |
493 | (while (re-search-forward (concat "^\\(\\S-\\)" regexp) nil t) | |
494 | (push (cons (match-string-no-properties 2) | |
92d9ce48 | 495 | (match-string-no-properties 1)) mp-list)) |
37e4d8ed RW |
496 | ;; generate new listing |
497 | (erase-buffer) | |
61548252 RW |
498 | (apply 'call-process (car command) nil t nil |
499 | (append (cdr command) (cdr (assoc proced-sorting-scheme | |
500 | proced-sorting-schemes-alist)))) | |
37e4d8ed RW |
501 | (goto-char (point-min)) |
502 | (while (not (eobp)) | |
503 | (insert " ") | |
504 | (forward-line)) | |
505 | ;; (delete-trailing-whitespace) | |
506 | (goto-char (point-min)) | |
507 | (while (re-search-forward "[ \t\r]+$" nil t) | |
508 | (delete-region (match-beginning 0) (match-end 0))) | |
37e4d8ed | 509 | (goto-char (point-min)) |
92d9ce48 RW |
510 | (let ((lep (line-end-position))) |
511 | ;; header line: code inspired by `ruler-mode-ruler' | |
512 | (setq header-line-format | |
513 | (list "" (if (eq 'left (car (window-current-scroll-bars))) | |
514 | (proced-header-space 'scroll-bar)) | |
515 | (proced-header-space 'left-fringe) | |
516 | (proced-header-space 'left-margin) | |
517 | (replace-regexp-in-string | |
518 | "%" "%%" (buffer-substring-no-properties (point) lep)))) | |
519 | (setq proced-header-alist nil) | |
520 | ;; FIXME: handle left/right justification properly | |
521 | (while (re-search-forward "\\([^ \t\n]+\\)[ \t]*\\($\\)?" lep t) | |
522 | (push (list (match-string-no-properties 1) | |
523 | ;; take the column number starting from zero | |
524 | (1- (match-beginning 0)) (or (not (not (match-beginning 2))) | |
525 | (1- (match-end 0))) | |
526 | 'left) | |
527 | proced-header-alist))) | |
528 | (let ((temp (regexp-opt (mapcar 'car proced-header-alist) t))) | |
529 | (setq proced-sorting-schemes-re | |
530 | (concat "\\`" temp "\\(," temp "\\)*\\'"))) | |
531 | ;; remove header line from ps(1) output | |
532 | (goto-char (point-min)) | |
533 | (delete-region (point) | |
534 | (save-excursion (forward-line) (point))) | |
535 | (set-buffer-modified-p nil) | |
536 | ;; set `proced-goal-column' | |
537 | (if proced-goal-header-re | |
538 | (let ((hlist proced-header-alist) header) | |
539 | (while (setq header (pop hlist)) | |
540 | (if (string-match proced-goal-header-re (car header)) | |
541 | (setq proced-goal-column | |
542 | (if (eq 'left (nth 3 header)) | |
543 | (nth 1 header) (nth 2 header)) | |
544 | hlist nil))))) | |
37e4d8ed | 545 | ;; restore process marks |
92d9ce48 | 546 | (if mp-list |
37e4d8ed | 547 | (save-excursion |
92d9ce48 | 548 | (goto-char (point-min)) |
37e4d8ed RW |
549 | (let (mark) |
550 | (while (re-search-forward (concat "^" regexp) nil t) | |
92d9ce48 | 551 | (if (setq mark (assoc (match-string-no-properties 1) mp-list)) |
37e4d8ed RW |
552 | (save-excursion |
553 | (beginning-of-line) | |
554 | (insert (cdr mark)) | |
555 | (delete-char 1))))))) | |
556 | ;; restore buffer position (if possible) | |
92d9ce48 | 557 | (goto-char (point-min)) |
37e4d8ed RW |
558 | (if (and old-pos |
559 | (re-search-forward | |
560 | (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos) "\\>") | |
561 | nil t)) | |
562 | (progn | |
563 | (beginning-of-line) | |
564 | (forward-char (cdr old-pos))) | |
92d9ce48 | 565 | (proced-move-to-goal-column)) |
61548252 | 566 | ;; update modeline |
92d9ce48 RW |
567 | ;; Does the long mode-name clutter the modeline? |
568 | (setq mode-name (concat "Proced: " proced-command | |
569 | (if proced-sorting-scheme | |
570 | (concat " by " proced-sorting-scheme) | |
571 | ""))) | |
61548252 RW |
572 | (force-mode-line-update) |
573 | ;; done | |
37e4d8ed RW |
574 | (or quiet (input-pending-p) |
575 | (message "Updating process information...done.")))) | |
576 | ||
577 | (defun proced-revert (&rest args) | |
578 | "Analog of `revert-buffer'." | |
579 | (proced-update)) | |
580 | ||
e6854b3f | 581 | ;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer' |
92d9ce48 RW |
582 | ;; and move it to window.el so that proced and ibuffer can easily use it, too? |
583 | ;; What about functions like `appt-disp-window' that use | |
584 | ;; `shrink-window-if-larger-than-buffer'? | |
37e4d8ed RW |
585 | (autoload 'dired-pop-to-buffer "dired") |
586 | ||
587 | (defun proced-send-signal (&optional signal) | |
588 | "Send a SIGNAL to the marked processes. | |
589 | SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. | |
590 | If SIGNAL is nil display marked processes and query interactively for SIGNAL." | |
591 | (interactive) | |
e6854b3f RW |
592 | (let ((regexp (concat (proced-marker-regexp) |
593 | (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$")) | |
92d9ce48 | 594 | process-list) |
37e4d8ed RW |
595 | ;; collect marked processes |
596 | (save-excursion | |
597 | (goto-char (point-min)) | |
598 | (while (re-search-forward regexp nil t) | |
599 | (push (cons (match-string-no-properties 1) | |
e6854b3f RW |
600 | ;; How much info should we collect here? Would it be |
601 | ;; better to collect only the PID (to avoid ambiguities) | |
602 | ;; and the command name? | |
37e4d8ed | 603 | (substring (match-string-no-properties 0) 2)) |
92d9ce48 RW |
604 | process-list))) |
605 | (setq process-list (nreverse process-list)) | |
606 | (if (not process-list) | |
37e4d8ed RW |
607 | (message "No processes marked") |
608 | (unless signal | |
609 | ;; Display marked processes (code taken from `dired-mark-pop-up'). | |
37e4d8ed | 610 | (let ((bufname " *Marked Processes*") |
92d9ce48 | 611 | (header header-line-format)) ; reuse |
37e4d8ed | 612 | (with-current-buffer (get-buffer-create bufname) |
92d9ce48 RW |
613 | (setq truncate-lines t |
614 | header-line-format header) | |
37e4d8ed | 615 | (erase-buffer) |
92d9ce48 RW |
616 | (dolist (process process-list) |
617 | (insert " " (cdr process) "\n")) | |
37e4d8ed RW |
618 | (save-window-excursion |
619 | (dired-pop-to-buffer bufname) ; all we need | |
620 | (let* ((completion-ignore-case t) | |
92d9ce48 | 621 | (pnum (if (= 1 (length process-list)) |
e6854b3f | 622 | "1 process" |
92d9ce48 | 623 | (format "%d processes" (length process-list)))) |
37e4d8ed RW |
624 | ;; The following is an ugly hack. Is there a better way |
625 | ;; to help people like me to remember the signals and | |
626 | ;; their meanings? | |
e6854b3f RW |
627 | (tmp (completing-read (concat "Send signal [" pnum |
628 | "] (default TERM): ") | |
37e4d8ed RW |
629 | proced-signal-list |
630 | nil nil nil nil "TERM"))) | |
631 | (setq signal (if (string-match "^\\(\\S-+\\)\\s-" tmp) | |
632 | (match-string 1 tmp) tmp)))))) | |
633 | ;; send signal | |
e6854b3f RW |
634 | (let ((count 0) |
635 | err-list) | |
636 | (if (functionp proced-signal-function) | |
637 | ;; use built-in `signal-process' | |
638 | (let ((signal (if (stringp signal) | |
639 | (if (string-match "\\`[0-9]+\\'" signal) | |
640 | (string-to-number signal) | |
641 | (make-symbol signal)) | |
642 | signal))) ; number | |
92d9ce48 | 643 | (dolist (process process-list) |
e6854b3f RW |
644 | (if (zerop (funcall |
645 | proced-signal-function | |
646 | (string-to-number (car process)) signal)) | |
52434c81 RW |
647 | (setq count (1+ count)) |
648 | (push (cdr process) err-list)))) | |
e6854b3f RW |
649 | ;; use external system call |
650 | (let ((signal (concat "-" (if (numberp signal) | |
651 | (number-to-string signal) signal)))) | |
92d9ce48 | 652 | (dolist (process process-list) |
e6854b3f RW |
653 | (if (zerop (call-process |
654 | proced-signal-function nil 0 nil | |
655 | signal (car process))) | |
52434c81 RW |
656 | (setq count (1+ count)) |
657 | (push (cdr process) err-list))))) | |
e6854b3f RW |
658 | (if err-list |
659 | ;; FIXME: that's not enough to display the errors. | |
660 | (message "%s: %s" signal err-list) | |
661 | (proced-success-message "Sent signal to" count))) | |
662 | ;; final clean-up | |
37e4d8ed RW |
663 | (run-hooks 'proced-after-send-signal-hook))))) |
664 | ||
665 | (defun proced-help () | |
666 | "Provide help for the `proced' user." | |
667 | (interactive) | |
668 | (if (eq last-command 'proced-help) | |
669 | (describe-mode) | |
670 | (message proced-help-string))) | |
671 | ||
672 | (defun proced-undo () | |
673 | "Undo in a proced buffer. | |
674 | This doesn't recover killed processes, it just undoes changes in the proced | |
675 | buffer. You can use it to recover marks." | |
676 | (interactive) | |
677 | (let (buffer-read-only) | |
678 | (undo)) | |
92d9ce48 | 679 | (message "Change in Proced buffer undone. |
37e4d8ed RW |
680 | Killed processes cannot be recovered by Emacs.")) |
681 | ||
61548252 RW |
682 | ;;; Sorting |
683 | (defun proced-sort (scheme) | |
684 | "Sort Proced buffer using SCHEME. | |
685 | When called interactively, an empty string means nil, i.e., no sorting." | |
686 | (interactive | |
687 | (list (let* ((completion-ignore-case t) | |
92d9ce48 RW |
688 | ;; restrict completion list to applicable sorting schemes |
689 | (completion-list | |
690 | (apply 'append | |
691 | (mapcar (lambda (x) | |
692 | (if (string-match proced-sorting-schemes-re | |
693 | (car x)) | |
694 | (list (car x)))) | |
695 | proced-sorting-schemes-alist))) | |
61548252 | 696 | (scheme (completing-read "Sorting type: " |
92d9ce48 | 697 | completion-list nil t))) |
61548252 RW |
698 | (if (string= "" scheme) nil scheme)))) |
699 | (if (proced-sorting-scheme-p scheme) | |
700 | (progn | |
701 | (setq proced-sorting-scheme scheme) | |
702 | (proced-update)) | |
92d9ce48 | 703 | (error "Proced sorting scheme %s not applicable" scheme))) |
61548252 RW |
704 | |
705 | (defun proced-sorting-scheme-p (scheme) | |
706 | "Return non-nil if SCHEME is an applicable sorting scheme. | |
707 | SCHEME must be a string or nil." | |
708 | (or (not scheme) | |
92d9ce48 RW |
709 | (and (string-match proced-sorting-schemes-re scheme) |
710 | (assoc scheme proced-sorting-schemes-alist)))) | |
61548252 RW |
711 | |
712 | (defun proced-sort-pcpu () | |
713 | "Sort Proced buffer by percentage CPU time (%CPU)." | |
714 | (interactive) | |
715 | (proced-sort "%CPU")) | |
716 | ||
717 | (defun proced-sort-pmem () | |
718 | "Sort Proced buffer by percentage memory usage (%MEM)." | |
719 | (interactive) | |
720 | (proced-sort "%MEM")) | |
721 | ||
722 | (defun proced-sort-pid () | |
723 | "Sort Proced buffer by PID." | |
724 | (interactive) | |
725 | (proced-sort "PID")) | |
726 | ||
727 | (defun proced-sort-start () | |
728 | "Sort Proced buffer by time the command started (START)." | |
729 | (interactive) | |
730 | (proced-sort "START")) | |
731 | ||
732 | (defun proced-sort-time () | |
733 | "Sort Proced buffer by cumulative CPU time (TIME)." | |
734 | (interactive) | |
735 | (proced-sort "TIME")) | |
736 | ||
37e4d8ed RW |
737 | (provide 'proced) |
738 | ||
dfab9988 | 739 | ;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af |
37e4d8ed | 740 | ;;; proced.el ends here. |