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