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