diff options
| author | Roland Winkler | 2008-05-20 10:17:15 +0000 |
|---|---|---|
| committer | Roland Winkler | 2008-05-20 10:17:15 +0000 |
| commit | 92d9ce488f041ee46359b6bf48ddba88e92e2571 (patch) | |
| tree | ba0b0f7ffa0081fa3a164abdc718e6786fdff371 | |
| parent | dde8403ffedfd27895053cb15410f7a2a6315c1a (diff) | |
| download | emacs-92d9ce488f041ee46359b6bf48ddba88e92e2571.tar.gz emacs-92d9ce488f041ee46359b6bf48ddba88e92e2571.zip | |
(proced-goal-header-re): Renamed from proced-procname-column-regexp.
(proced-goal-column): Renamed from proced-procname-column.
(proced-move-to-goal-column): Renamed from
proced-move-to-procname.
(proced-header-face, proced-header-regexp): Removed.
(proced-font-lock-keywords): Remove proced-header-face.
(proced-header-alist, proced-sorting-schemes-re): New variables.
(proced): Rename Proced buffer to *Proced*.
(proced-next-line, proced-previous-line): New commands.
(proced-do-mark, proced-do-mark-all, proced-toggle-marks)
(proced-hide-processes): Do not treat first line as special.
(proced-header-space): New function.
(proced-update): Use header-line-format. Initialize
proced-header-alist and proced-sorting-schemes-re. Set
proced-goal-column. Include proced-command in mode-name.
(proced-send-signal): Use header-line-format for *Marked
Processes* buffer.
(proced-sort): Restrict minibuffer completion to applicable
sorting schemes.
(proced-sorting-scheme-p): Use proced-sorting-schemes-re.
| -rw-r--r-- | lisp/proced.el | 301 |
1 files changed, 188 insertions, 113 deletions
diff --git a/lisp/proced.el b/lisp/proced.el index daeadae5af8..7ab719114e1 100644 --- a/lisp/proced.el +++ b/lisp/proced.el | |||
| @@ -28,6 +28,10 @@ | |||
| 28 | ;; on the processes listed. | 28 | ;; on the processes listed. |
| 29 | ;; | 29 | ;; |
| 30 | ;; To do: | 30 | ;; To do: |
| 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"? | ||
| 31 | ;; - sort the "cooked" values used in the output format fields | 35 | ;; - sort the "cooked" values used in the output format fields |
| 32 | ;; if ps(1) doesn't support the requested sorting scheme | 36 | ;; if ps(1) doesn't support the requested sorting scheme |
| 33 | ;; - filter by user name or other criteria | 37 | ;; - filter by user name or other criteria |
| @@ -41,12 +45,8 @@ | |||
| 41 | :group 'unix | 45 | :group 'unix |
| 42 | :prefix "proced-") | 46 | :prefix "proced-") |
| 43 | 47 | ||
| 44 | (defcustom proced-procname-column-regexp "\\b\\(CMD\\|COMMAND\\)\\b" | 48 | ;; FIXME: a better approach instead of PID-COLUMN would be based |
| 45 | "If non-nil, regexp that defines the `proced-procname-column'." | 49 | ;; on `proced-header-alist' once we have a reliable scheme to set this variable |
| 46 | :group 'proced | ||
| 47 | :type '(choice (const :tag "none" nil) | ||
| 48 | (regexp :tag "regexp"))) | ||
| 49 | |||
| 50 | (defcustom proced-command-alist | 50 | (defcustom proced-command-alist |
| 51 | (cond ((memq system-type '(berkeley-unix)) | 51 | (cond ((memq system-type '(berkeley-unix)) |
| 52 | '(("user" ("ps" "-uxgww") 2) | 52 | '(("user" ("ps" "-uxgww") 2) |
| @@ -81,7 +81,18 @@ PID-COLUMN is the column number (starting from 1) of the process ID." | |||
| 81 | (repeat (string :tag "option"))) | 81 | (repeat (string :tag "option"))) |
| 82 | (integer :tag "PID column")))) | 82 | (integer :tag "PID column")))) |
| 83 | 83 | ||
| 84 | ;; Should we incorporate in NAME if sorting is done in descending order? | 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 | ||
| 85 | (defcustom proced-sorting-schemes-alist | 96 | (defcustom proced-sorting-schemes-alist |
| 86 | (cond ((memq system-type '(gnu gnu/linux)) ; GNU long options | 97 | (cond ((memq system-type '(gnu gnu/linux)) ; GNU long options |
| 87 | '(("%CPU" "--sort" "-pcpu") ; descending order | 98 | '(("%CPU" "--sort" "-pcpu") ; descending order |
| @@ -100,8 +111,9 @@ PID-COLUMN is the column number (starting from 1) of the process ID." | |||
| 100 | ("VSZ,PID" "--sort" "vsz,pid")))) | 111 | ("VSZ,PID" "--sort" "vsz,pid")))) |
| 101 | "Alist of sorting schemes. | 112 | "Alist of sorting schemes. |
| 102 | Each element is a list (NAME OPTION1 OPTION2 ...). | 113 | Each element is a list (NAME OPTION1 OPTION2 ...). |
| 103 | NAME denotes the sorting scheme and OPTION1, OPTION2, ... are options | 114 | NAME denotes the sorting scheme. It is the name of a header or a |
| 104 | defining the sorting scheme." | 115 | comma-separated sequence of headers in the output of ps(1). |
| 116 | OPTION1, OPTION2, ... are options defining the sorting scheme." | ||
| 105 | :group 'proced | 117 | :group 'proced |
| 106 | :type '(repeat (cons (string :tag "name") | 118 | :type '(repeat (cons (string :tag "name") |
| 107 | (repeat (string :tag "option"))))) | 119 | (repeat (string :tag "option"))))) |
| @@ -116,12 +128,11 @@ Must be the car of an element of `proced-sorting-schemes-alist' or nil." | |||
| 116 | proced-sorting-schemes-alist)))) | 128 | proced-sorting-schemes-alist)))) |
| 117 | (make-variable-buffer-local 'proced-sorting-scheme) | 129 | (make-variable-buffer-local 'proced-sorting-scheme) |
| 118 | 130 | ||
| 119 | (defcustom proced-command (if (zerop (user-real-uid)) "all" "user") | 131 | (defcustom proced-goal-header-re "\\b\\(CMD\\|COMMAND\\)\\b" |
| 120 | "Name of process listing. | 132 | "If non-nil, regexp that defines the `proced-goal-column'." |
| 121 | Must be the car of an element of `proced-command-alist'." | ||
| 122 | :group 'proced | 133 | :group 'proced |
| 123 | :type '(string :tag "name")) | 134 | :type '(choice (const :tag "none" nil) |
| 124 | (make-variable-buffer-local 'proced-command) | 135 | (regexp :tag "regexp"))) |
| 125 | 136 | ||
| 126 | (defcustom proced-signal-function 'signal-process | 137 | (defcustom proced-signal-function 'signal-process |
| 127 | "Name of signal function. | 138 | "Name of signal function. |
| @@ -143,6 +154,7 @@ the external command (usually \"kill\")." | |||
| 143 | :group 'proced | 154 | :group 'proced |
| 144 | :type '(repeat (string :tag "signal"))) | 155 | :type '(repeat (string :tag "signal"))) |
| 145 | 156 | ||
| 157 | ;; Internal variables | ||
| 146 | (defvar proced-marker-char ?* ; the answer is 42 | 158 | (defvar proced-marker-char ?* ; the answer is 42 |
| 147 | "In proced, the current mark character.") | 159 | "In proced, the current mark character.") |
| 148 | 160 | ||
| @@ -152,13 +164,6 @@ the external command (usually \"kill\")." | |||
| 152 | :group 'proced | 164 | :group 'proced |
| 153 | :group 'faces) | 165 | :group 'faces) |
| 154 | 166 | ||
| 155 | (defface proced-header | ||
| 156 | '((t (:inherit font-lock-type-face))) | ||
| 157 | "Face used for proced headers." | ||
| 158 | :group 'proced-faces) | ||
| 159 | (defvar proced-header-face 'proced-header | ||
| 160 | "Face name used for proced headers.") | ||
| 161 | |||
| 162 | (defface proced-mark | 167 | (defface proced-mark |
| 163 | '((t (:inherit font-lock-constant-face))) | 168 | '((t (:inherit font-lock-constant-face))) |
| 164 | "Face used for proced marks." | 169 | "Face used for proced marks." |
| @@ -177,54 +182,56 @@ the external command (usually \"kill\")." | |||
| 177 | "Regexp matching a marked line. | 182 | "Regexp matching a marked line. |
| 178 | Important: the match ends just after the marker.") | 183 | Important: the match ends just after the marker.") |
| 179 | 184 | ||
| 180 | (defvar proced-header-regexp "\\`.*$" | 185 | (defvar proced-goal-column nil |
| 181 | "Regexp matching a header line.") | 186 | "Proced goal column. Initialized based on `proced-goal-header-re'.") |
| 182 | 187 | (make-variable-buffer-local 'proced-goal-column) | |
| 183 | (defvar proced-procname-column nil | ||
| 184 | "Proced command column. | ||
| 185 | Initialized based on `proced-procname-column-regexp'.") | ||
| 186 | (make-variable-buffer-local 'proced-procname-column) | ||
| 187 | 188 | ||
| 188 | (defvar proced-font-lock-keywords | 189 | (defvar proced-font-lock-keywords |
| 189 | (list | 190 | (list |
| 190 | ;; | 191 | ;; |
| 191 | ;; Process listing headers. | ||
| 192 | (list proced-header-regexp '(0 proced-header-face)) | ||
| 193 | ;; | ||
| 194 | ;; Proced marks. | 192 | ;; Proced marks. |
| 195 | (list proced-re-mark '(0 proced-mark-face)) | 193 | (list proced-re-mark '(0 proced-mark-face)) |
| 196 | ;; | 194 | ;; |
| 197 | ;; Marked files. | 195 | ;; Marked files. |
| 198 | (list (concat "^[" (char-to-string proced-marker-char) "]") | 196 | (list (concat "^[" (char-to-string proced-marker-char) "]") |
| 199 | '(".+" (proced-move-to-procname) nil (0 proced-marked-face))))) | 197 | '(".+" (proced-move-to-goal-column) nil (0 proced-marked-face))))) |
| 200 | 198 | ||
| 201 | (defvar proced-mode-map | 199 | (defvar proced-mode-map |
| 202 | (let ((km (make-sparse-keymap))) | 200 | (let ((km (make-sparse-keymap))) |
| 203 | (define-key km " " 'next-line) | 201 | ;; moving |
| 204 | (define-key km "n" 'next-line) | 202 | (define-key km " " 'proced-next-line) |
| 205 | (define-key km "p" 'previous-line) | 203 | (define-key km "n" 'proced-next-line) |
| 206 | (define-key km "\C-?" 'previous-line) | 204 | (define-key km "p" 'proced-previous-line) |
| 207 | (define-key km "h" 'describe-mode) | 205 | (define-key km "\C-n" 'proced-next-line) |
| 208 | (define-key km "?" 'proced-help) | 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 | ||
| 209 | (define-key km "d" 'proced-mark) ; Dired compatibility | 211 | (define-key km "d" 'proced-mark) ; Dired compatibility |
| 210 | (define-key km "m" 'proced-mark) | 212 | (define-key km "m" 'proced-mark) |
| 211 | (define-key km "M" 'proced-mark-all) | ||
| 212 | (define-key km "u" 'proced-unmark) | 213 | (define-key km "u" 'proced-unmark) |
| 213 | (define-key km "\177" 'proced-unmark-backward) | 214 | (define-key km "\177" 'proced-unmark-backward) |
| 215 | (define-key km "M" 'proced-mark-all) | ||
| 214 | (define-key km "U" 'proced-unmark-all) | 216 | (define-key km "U" 'proced-unmark-all) |
| 215 | (define-key km "t" 'proced-toggle-marks) | 217 | (define-key km "t" 'proced-toggle-marks) |
| 216 | (define-key km "h" 'proced-hide-processes) | 218 | ;; sorting |
| 217 | (define-key km "x" 'proced-send-signal) ; Dired compatibility | ||
| 218 | (define-key km "k" 'proced-send-signal) ; kill processes | ||
| 219 | (define-key km "l" 'proced-listing-type) | ||
| 220 | (define-key km "g" 'revert-buffer) ; Dired compatibility | ||
| 221 | (define-key km "q" 'quit-window) | ||
| 222 | (define-key km "sc" 'proced-sort-pcpu) | 219 | (define-key km "sc" 'proced-sort-pcpu) |
| 223 | (define-key km "sm" 'proced-sort-pmem) | 220 | (define-key km "sm" 'proced-sort-pmem) |
| 224 | (define-key km "sp" 'proced-sort-pid) | 221 | (define-key km "sp" 'proced-sort-pid) |
| 225 | (define-key km "ss" 'proced-sort-start) | 222 | (define-key km "ss" 'proced-sort-start) |
| 226 | (define-key km "sS" 'proced-sort) | 223 | (define-key km "sS" 'proced-sort) |
| 227 | (define-key km "st" 'proced-sort-time) | 224 | (define-key km "st" 'proced-sort-time) |
| 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) | ||
| 228 | (define-key km [remap undo] 'proced-undo) | 235 | (define-key km [remap undo] 'proced-undo) |
| 229 | (define-key km [remap advertised-undo] 'proced-undo) | 236 | (define-key km [remap advertised-undo] 'proced-undo) |
| 230 | km) | 237 | km) |
| @@ -256,24 +263,40 @@ Initialized based on `proced-procname-column-regexp'.") | |||
| 256 | "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)" | 263 | "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)" |
| 257 | "Help string for proced.") | 264 | "Help string for proced.") |
| 258 | 265 | ||
| 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 | ||
| 259 | (defun proced-marker-regexp () | 280 | (defun proced-marker-regexp () |
| 260 | "Return regexp matching `proced-marker-char'." | 281 | "Return regexp matching `proced-marker-char'." |
| 282 | ;; `proced-marker-char' must appear in column zero | ||
| 261 | (concat "^" (regexp-quote (char-to-string proced-marker-char)))) | 283 | (concat "^" (regexp-quote (char-to-string proced-marker-char)))) |
| 262 | 284 | ||
| 263 | (defun proced-success-message (action count) | 285 | (defun proced-success-message (action count) |
| 264 | "Display success message for ACTION performed for COUNT processes." | 286 | "Display success message for ACTION performed for COUNT processes." |
| 265 | (message "%s %s process%s" action count (if (= 1 count) "" "es"))) | 287 | (message "%s %s process%s" action count (if (= 1 count) "" "es"))) |
| 266 | 288 | ||
| 267 | (defun proced-move-to-procname () | 289 | (defun proced-move-to-goal-column () |
| 268 | "Move to the beginning of the process name on the current line. | 290 | "Move to `proced-goal-column' if non-nil." |
| 269 | Return the position of the beginning of the process name, or nil if none found." | ||
| 270 | (beginning-of-line) | 291 | (beginning-of-line) |
| 271 | (if proced-procname-column | 292 | (if proced-goal-column |
| 272 | (forward-char proced-procname-column) | 293 | (forward-char proced-goal-column) |
| 273 | (forward-char 2))) | 294 | (forward-char 2))) |
| 274 | 295 | ||
| 296 | ;; FIXME: a better approach would be based on `proced-header-alist' | ||
| 297 | ;; once we have a reliable scheme to set this variable | ||
| 275 | (defsubst proced-skip-regexp () | 298 | (defsubst proced-skip-regexp () |
| 276 | "Regexp to skip in process listing." | 299 | "Regexp to skip in process listing to find PID column." |
| 277 | (apply 'concat (make-list (1- (nth 2 (assoc proced-command | 300 | (apply 'concat (make-list (1- (nth 2 (assoc proced-command |
| 278 | proced-command-alist))) | 301 | proced-command-alist))) |
| 279 | "\\s-+\\S-+"))) | 302 | "\\s-+\\S-+"))) |
| @@ -306,7 +329,7 @@ information will be displayed but not selected. | |||
| 306 | 329 | ||
| 307 | \\{proced-mode-map}" | 330 | \\{proced-mode-map}" |
| 308 | (interactive "P") | 331 | (interactive "P") |
| 309 | (let ((buffer (get-buffer-create "*Process Info*")) new) | 332 | (let ((buffer (get-buffer-create "*Proced*")) new) |
| 310 | (set-buffer buffer) | 333 | (set-buffer buffer) |
| 311 | (setq new (zerop (buffer-size))) | 334 | (setq new (zerop (buffer-size))) |
| 312 | (if new (proced-mode)) | 335 | (if new (proced-mode)) |
| @@ -320,6 +343,20 @@ information will be displayed but not selected. | |||
| 320 | (message (substitute-command-keys | 343 | (message (substitute-command-keys |
| 321 | "type \\[quit-window] to quit, \\[proced-help] for help"))))) | 344 | "type \\[quit-window] to quit, \\[proced-help] for help"))))) |
| 322 | 345 | ||
| 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 | |||
| 323 | (defun proced-mark (&optional count) | 360 | (defun proced-mark (&optional count) |
| 324 | "Mark the current (or next COUNT) processes." | 361 | "Mark the current (or next COUNT) processes." |
| 325 | (interactive "p") | 362 | (interactive "p") |
| @@ -341,16 +378,13 @@ information will be displayed but not selected. | |||
| 341 | "Mark the current (or next ARG) processes using MARK." | 378 | "Mark the current (or next ARG) processes using MARK." |
| 342 | (or count (setq count 1)) | 379 | (or count (setq count 1)) |
| 343 | (let ((backward (< count 0)) | 380 | (let ((backward (< count 0)) |
| 344 | (line (line-number-at-pos)) | ||
| 345 | buffer-read-only) | 381 | buffer-read-only) |
| 346 | ;; do nothing in the first line | 382 | (setq count (1+ (if (<= 0 count) count |
| 347 | (unless (= line 1) | 383 | (min (1- (line-number-at-pos)) (abs count))))) |
| 348 | (setq count (1+ (if (<= 0 count) count | 384 | (beginning-of-line) |
| 349 | (min (- line 2) (abs count))))) | 385 | (while (not (or (zerop (setq count (1- count))) (eobp))) |
| 350 | (beginning-of-line) | 386 | (proced-insert-mark mark backward)) |
| 351 | (while (not (or (zerop (setq count (1- count))) (eobp))) | 387 | (proced-move-to-goal-column))) |
| 352 | (proced-insert-mark mark backward)) | ||
| 353 | (proced-move-to-procname)))) | ||
| 354 | 388 | ||
| 355 | (defun proced-mark-all () | 389 | (defun proced-mark-all () |
| 356 | "Mark all processes." | 390 | "Mark all processes." |
| @@ -366,7 +400,7 @@ information will be displayed but not selected. | |||
| 366 | "Mark all processes using MARK." | 400 | "Mark all processes using MARK." |
| 367 | (let (buffer-read-only) | 401 | (let (buffer-read-only) |
| 368 | (save-excursion | 402 | (save-excursion |
| 369 | (goto-line 2) | 403 | (goto-char (point-min)) |
| 370 | (while (not (eobp)) | 404 | (while (not (eobp)) |
| 371 | (proced-insert-mark mark))))) | 405 | (proced-insert-mark mark))))) |
| 372 | 406 | ||
| @@ -376,7 +410,7 @@ information will be displayed but not selected. | |||
| 376 | (let ((mark-re (proced-marker-regexp)) | 410 | (let ((mark-re (proced-marker-regexp)) |
| 377 | buffer-read-only) | 411 | buffer-read-only) |
| 378 | (save-excursion | 412 | (save-excursion |
| 379 | (goto-line 2) | 413 | (goto-char (point-min)) |
| 380 | (while (not (eobp)) | 414 | (while (not (eobp)) |
| 381 | (cond ((looking-at mark-re) | 415 | (cond ((looking-at mark-re) |
| 382 | (proced-insert-mark nil)) | 416 | (proced-insert-mark nil)) |
| @@ -411,26 +445,22 @@ Returns count of hidden lines." | |||
| 411 | (save-excursion | 445 | (save-excursion |
| 412 | (if arg | 446 | (if arg |
| 413 | ;; Hide ARG lines starting with the current line. | 447 | ;; Hide ARG lines starting with the current line. |
| 414 | (let ((line (line-number-at-pos))) | 448 | (delete-region (line-beginning-position) |
| 415 | ;; do nothing in the first line | 449 | (save-excursion |
| 416 | (unless (= line 1) | 450 | (if (<= 0 arg) |
| 417 | (delete-region (line-beginning-position) | 451 | (setq count (- arg (forward-line arg))) |
| 418 | (save-excursion | 452 | (setq count (min (1- (line-number-at-pos)) |
| 419 | (if (<= 0 arg) | 453 | (abs arg))) |
| 420 | (setq count (- arg (forward-line arg))) | 454 | (forward-line (- count))) |
| 421 | (setq count (min (- line 2) (abs arg))) | 455 | (point))) |
| 422 | (forward-line (- count))) | ||
| 423 | (point))))) | ||
| 424 | ;; Hide marked lines | 456 | ;; Hide marked lines |
| 425 | (goto-line 2) | ||
| 426 | (while (and (not (eobp)) | 457 | (while (and (not (eobp)) |
| 427 | (re-search-forward mark-re nil t)) | 458 | (re-search-forward mark-re nil t)) |
| 428 | (delete-region (match-beginning 0) | 459 | (delete-region (match-beginning 0) |
| 429 | (save-excursion (forward-line) (point))) | 460 | (save-excursion (forward-line) (point))) |
| 430 | (setq count (1+ count))))) | 461 | (setq count (1+ count))))) |
| 431 | (unless (zerop count) (proced-move-to-procname)) | 462 | (unless (zerop count) (proced-move-to-goal-column)) |
| 432 | (unless quiet | 463 | (unless quiet (proced-success-message "Hid" count)) |
| 433 | (proced-success-message "Hid" count)) | ||
| 434 | count)) | 464 | count)) |
| 435 | 465 | ||
| 436 | (defun proced-listing-type (command) | 466 | (defun proced-listing-type (command) |
| @@ -440,6 +470,11 @@ Returns count of hidden lines." | |||
| 440 | (setq proced-command command) | 470 | (setq proced-command command) |
| 441 | (proced-update)) | 471 | (proced-update)) |
| 442 | 472 | ||
| 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 | |||
| 443 | (defun proced-update (&optional quiet) | 478 | (defun proced-update (&optional quiet) |
| 444 | "Update the `proced' process information. Preserves point and marks." | 479 | "Update the `proced' process information. Preserves point and marks." |
| 445 | ;; This is the main function that generates and updates the process listing. | 480 | ;; This is the main function that generates and updates the process listing. |
| @@ -452,12 +487,12 @@ Returns count of hidden lines." | |||
| 452 | (looking-at (concat "^[* ]" regexp))) | 487 | (looking-at (concat "^[* ]" regexp))) |
| 453 | (cons (match-string-no-properties 1) | 488 | (cons (match-string-no-properties 1) |
| 454 | (current-column)))) | 489 | (current-column)))) |
| 455 | buffer-read-only plist) | 490 | buffer-read-only mp-list) |
| 456 | (goto-char (point-min)) | 491 | (goto-char (point-min)) |
| 457 | ;; remember marked processes (whatever the mark was) | 492 | ;; remember marked processes (whatever the mark was) |
| 458 | (while (re-search-forward (concat "^\\(\\S-\\)" regexp) nil t) | 493 | (while (re-search-forward (concat "^\\(\\S-\\)" regexp) nil t) |
| 459 | (push (cons (match-string-no-properties 2) | 494 | (push (cons (match-string-no-properties 2) |
| 460 | (match-string-no-properties 1)) plist)) | 495 | (match-string-no-properties 1)) mp-list)) |
| 461 | ;; generate new listing | 496 | ;; generate new listing |
| 462 | (erase-buffer) | 497 | (erase-buffer) |
| 463 | (apply 'call-process (car command) nil t nil | 498 | (apply 'call-process (car command) nil t nil |
| @@ -471,25 +506,55 @@ Returns count of hidden lines." | |||
| 471 | (goto-char (point-min)) | 506 | (goto-char (point-min)) |
| 472 | (while (re-search-forward "[ \t\r]+$" nil t) | 507 | (while (re-search-forward "[ \t\r]+$" nil t) |
| 473 | (delete-region (match-beginning 0) (match-end 0))) | 508 | (delete-region (match-beginning 0) (match-end 0))) |
| 474 | (set-buffer-modified-p nil) | ||
| 475 | ;; set `proced-procname-column' | ||
| 476 | (goto-char (point-min)) | 509 | (goto-char (point-min)) |
| 477 | (and proced-procname-column-regexp | 510 | (let ((lep (line-end-position))) |
| 478 | (re-search-forward proced-procname-column-regexp nil t) | 511 | ;; header line: code inspired by `ruler-mode-ruler' |
| 479 | (setq proced-procname-column (1- (match-beginning 0)))) | 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))))) | ||
| 480 | ;; restore process marks | 545 | ;; restore process marks |
| 481 | (if plist | 546 | (if mp-list |
| 482 | (save-excursion | 547 | (save-excursion |
| 483 | (goto-line 2) | 548 | (goto-char (point-min)) |
| 484 | (let (mark) | 549 | (let (mark) |
| 485 | (while (re-search-forward (concat "^" regexp) nil t) | 550 | (while (re-search-forward (concat "^" regexp) nil t) |
| 486 | (if (setq mark (assoc (match-string-no-properties 1) plist)) | 551 | (if (setq mark (assoc (match-string-no-properties 1) mp-list)) |
| 487 | (save-excursion | 552 | (save-excursion |
| 488 | (beginning-of-line) | 553 | (beginning-of-line) |
| 489 | (insert (cdr mark)) | 554 | (insert (cdr mark)) |
| 490 | (delete-char 1))))))) | 555 | (delete-char 1))))))) |
| 491 | ;; restore buffer position (if possible) | 556 | ;; restore buffer position (if possible) |
| 492 | (goto-line 2) | 557 | (goto-char (point-min)) |
| 493 | (if (and old-pos | 558 | (if (and old-pos |
| 494 | (re-search-forward | 559 | (re-search-forward |
| 495 | (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos) "\\>") | 560 | (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos) "\\>") |
| @@ -497,11 +562,13 @@ Returns count of hidden lines." | |||
| 497 | (progn | 562 | (progn |
| 498 | (beginning-of-line) | 563 | (beginning-of-line) |
| 499 | (forward-char (cdr old-pos))) | 564 | (forward-char (cdr old-pos))) |
| 500 | (proced-move-to-procname)) | 565 | (proced-move-to-goal-column)) |
| 501 | ;; update modeline | 566 | ;; update modeline |
| 502 | (setq mode-name (if proced-sorting-scheme | 567 | ;; Does the long mode-name clutter the modeline? |
| 503 | (concat "Proced by " proced-sorting-scheme) | 568 | (setq mode-name (concat "Proced: " proced-command |
| 504 | "Proced")) | 569 | (if proced-sorting-scheme |
| 570 | (concat " by " proced-sorting-scheme) | ||
| 571 | ""))) | ||
| 505 | (force-mode-line-update) | 572 | (force-mode-line-update) |
| 506 | ;; done | 573 | ;; done |
| 507 | (or quiet (input-pending-p) | 574 | (or quiet (input-pending-p) |
| @@ -512,7 +579,9 @@ Returns count of hidden lines." | |||
| 512 | (proced-update)) | 579 | (proced-update)) |
| 513 | 580 | ||
| 514 | ;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer' | 581 | ;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer' |
| 515 | ;; and move it to simple.el so that proced and ibuffer can easily use it, too? | 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'? | ||
| 516 | (autoload 'dired-pop-to-buffer "dired") | 585 | (autoload 'dired-pop-to-buffer "dired") |
| 517 | 586 | ||
| 518 | (defun proced-send-signal (&optional signal) | 587 | (defun proced-send-signal (&optional signal) |
| @@ -522,7 +591,7 @@ If SIGNAL is nil display marked processes and query interactively for SIGNAL." | |||
| 522 | (interactive) | 591 | (interactive) |
| 523 | (let ((regexp (concat (proced-marker-regexp) | 592 | (let ((regexp (concat (proced-marker-regexp) |
| 524 | (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$")) | 593 | (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$")) |
| 525 | plist) | 594 | process-list) |
| 526 | ;; collect marked processes | 595 | ;; collect marked processes |
| 527 | (save-excursion | 596 | (save-excursion |
| 528 | (goto-char (point-min)) | 597 | (goto-char (point-min)) |
| @@ -532,29 +601,26 @@ If SIGNAL is nil display marked processes and query interactively for SIGNAL." | |||
| 532 | ;; better to collect only the PID (to avoid ambiguities) | 601 | ;; better to collect only the PID (to avoid ambiguities) |
| 533 | ;; and the command name? | 602 | ;; and the command name? |
| 534 | (substring (match-string-no-properties 0) 2)) | 603 | (substring (match-string-no-properties 0) 2)) |
| 535 | plist))) | 604 | process-list))) |
| 536 | (setq plist (nreverse plist)) | 605 | (setq process-list (nreverse process-list)) |
| 537 | (if (not plist) | 606 | (if (not process-list) |
| 538 | (message "No processes marked") | 607 | (message "No processes marked") |
| 539 | (unless signal | 608 | (unless signal |
| 540 | ;; Display marked processes (code taken from `dired-mark-pop-up'). | 609 | ;; Display marked processes (code taken from `dired-mark-pop-up'). |
| 541 | (let ((bufname " *Marked Processes*") | 610 | (let ((bufname " *Marked Processes*") |
| 542 | (header (save-excursion | 611 | (header header-line-format)) ; reuse |
| 543 | (goto-char (+ 2 (point-min))) | ||
| 544 | (buffer-substring-no-properties | ||
| 545 | (point) (line-end-position))))) | ||
| 546 | (with-current-buffer (get-buffer-create bufname) | 612 | (with-current-buffer (get-buffer-create bufname) |
| 547 | (setq truncate-lines t) | 613 | (setq truncate-lines t |
| 614 | header-line-format header) | ||
| 548 | (erase-buffer) | 615 | (erase-buffer) |
| 549 | (insert header "\n") | 616 | (dolist (process process-list) |
| 550 | (dolist (proc plist) | 617 | (insert " " (cdr process) "\n")) |
| 551 | (insert (cdr proc) "\n")) | ||
| 552 | (save-window-excursion | 618 | (save-window-excursion |
| 553 | (dired-pop-to-buffer bufname) ; all we need | 619 | (dired-pop-to-buffer bufname) ; all we need |
| 554 | (let* ((completion-ignore-case t) | 620 | (let* ((completion-ignore-case t) |
| 555 | (pnum (if (= 1 (length plist)) | 621 | (pnum (if (= 1 (length process-list)) |
| 556 | "1 process" | 622 | "1 process" |
| 557 | (format "%d processes" (length plist)))) | 623 | (format "%d processes" (length process-list)))) |
| 558 | ;; The following is an ugly hack. Is there a better way | 624 | ;; The following is an ugly hack. Is there a better way |
| 559 | ;; to help people like me to remember the signals and | 625 | ;; to help people like me to remember the signals and |
| 560 | ;; their meanings? | 626 | ;; their meanings? |
| @@ -574,7 +640,7 @@ If SIGNAL is nil display marked processes and query interactively for SIGNAL." | |||
| 574 | (string-to-number signal) | 640 | (string-to-number signal) |
| 575 | (make-symbol signal)) | 641 | (make-symbol signal)) |
| 576 | signal))) ; number | 642 | signal))) ; number |
| 577 | (dolist (process plist) | 643 | (dolist (process process-list) |
| 578 | (if (zerop (funcall | 644 | (if (zerop (funcall |
| 579 | proced-signal-function | 645 | proced-signal-function |
| 580 | (string-to-number (car process)) signal)) | 646 | (string-to-number (car process)) signal)) |
| @@ -583,7 +649,7 @@ If SIGNAL is nil display marked processes and query interactively for SIGNAL." | |||
| 583 | ;; use external system call | 649 | ;; use external system call |
| 584 | (let ((signal (concat "-" (if (numberp signal) | 650 | (let ((signal (concat "-" (if (numberp signal) |
| 585 | (number-to-string signal) signal)))) | 651 | (number-to-string signal) signal)))) |
| 586 | (dolist (process plist) | 652 | (dolist (process process-list) |
| 587 | (if (zerop (call-process | 653 | (if (zerop (call-process |
| 588 | proced-signal-function nil 0 nil | 654 | proced-signal-function nil 0 nil |
| 589 | signal (car process))) | 655 | signal (car process))) |
| @@ -610,7 +676,7 @@ buffer. You can use it to recover marks." | |||
| 610 | (interactive) | 676 | (interactive) |
| 611 | (let (buffer-read-only) | 677 | (let (buffer-read-only) |
| 612 | (undo)) | 678 | (undo)) |
| 613 | (message "Change in proced buffer undone. | 679 | (message "Change in Proced buffer undone. |
| 614 | Killed processes cannot be recovered by Emacs.")) | 680 | Killed processes cannot be recovered by Emacs.")) |
| 615 | 681 | ||
| 616 | ;;; Sorting | 682 | ;;; Sorting |
| @@ -619,20 +685,29 @@ Killed processes cannot be recovered by Emacs.")) | |||
| 619 | When called interactively, an empty string means nil, i.e., no sorting." | 685 | When called interactively, an empty string means nil, i.e., no sorting." |
| 620 | (interactive | 686 | (interactive |
| 621 | (list (let* ((completion-ignore-case t) | 687 | (list (let* ((completion-ignore-case t) |
| 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))) | ||
| 622 | (scheme (completing-read "Sorting type: " | 696 | (scheme (completing-read "Sorting type: " |
| 623 | proced-sorting-schemes-alist nil t))) | 697 | completion-list nil t))) |
| 624 | (if (string= "" scheme) nil scheme)))) | 698 | (if (string= "" scheme) nil scheme)))) |
| 625 | (if (proced-sorting-scheme-p scheme) | 699 | (if (proced-sorting-scheme-p scheme) |
| 626 | (progn | 700 | (progn |
| 627 | (setq proced-sorting-scheme scheme) | 701 | (setq proced-sorting-scheme scheme) |
| 628 | (proced-update)) | 702 | (proced-update)) |
| 629 | (error "Proced sorting scheme %s undefined" scheme))) | 703 | (error "Proced sorting scheme %s not applicable" scheme))) |
| 630 | 704 | ||
| 631 | (defun proced-sorting-scheme-p (scheme) | 705 | (defun proced-sorting-scheme-p (scheme) |
| 632 | "Return non-nil if SCHEME is an applicable sorting scheme. | 706 | "Return non-nil if SCHEME is an applicable sorting scheme. |
| 633 | SCHEME must be a string or nil." | 707 | SCHEME must be a string or nil." |
| 634 | (or (not scheme) | 708 | (or (not scheme) |
| 635 | (assoc scheme proced-sorting-schemes-alist))) | 709 | (and (string-match proced-sorting-schemes-re scheme) |
| 710 | (assoc scheme proced-sorting-schemes-alist)))) | ||
| 636 | 711 | ||
| 637 | (defun proced-sort-pcpu () | 712 | (defun proced-sort-pcpu () |
| 638 | "Sort Proced buffer by percentage CPU time (%CPU)." | 713 | "Sort Proced buffer by percentage CPU time (%CPU)." |