Mercurial > emacs
comparison lisp/proced.el @ 100847:883cbe72dc04
(proced-grammar-alist): Refiner can be a list (function help-echo)
instead of a cons pair.
(proced-post-display-hook): New variable.
(proced-tree-depth): Renamed from proced-tree-indent.
(proced-mode): Derive mode from special-mode.
(proced-mode-map): Changed accordingly.
(proced, proced-update): Run proced-post-display-hook.
(proced-do-mark-all): Count processes for which mark has been
updated.
(proced-format): Check for ppid attribute.
(proced-process-attributes): Take time and ctime attribute from
system-process-attributes.
(proced-send-signal): Doc fix. Collect properly the info on
marked processes. Use fit-window-to-buffer instead of
dired-pop-to-buffer.
author | Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> |
---|---|
date | Sat, 03 Jan 2009 12:18:53 +0000 |
parents | 6a68c7a91e31 |
children | a9dc0e7c3f2b |
comparison
equal
deleted
inserted
replaced
100846:d74b83c02d95 | 100847:883cbe72dc04 |
---|---|
100 (egid "EGID" "%d" right proced-< nil (egid euid pid) (nil t nil)) | 100 (egid "EGID" "%d" right proced-< nil (egid euid pid) (nil t nil)) |
101 (group "GROUP" nil left proced-string-lessp nil (group user pid) (nil t nil)) | 101 (group "GROUP" nil left proced-string-lessp nil (group user pid) (nil t nil)) |
102 (comm "COMMAND" nil left proced-string-lessp nil (comm pid) (nil t nil)) | 102 (comm "COMMAND" nil left proced-string-lessp nil (comm pid) (nil t nil)) |
103 (state "STAT" nil left proced-string-lessp nil (state pid) (nil t nil)) | 103 (state "STAT" nil left proced-string-lessp nil (state pid) (nil t nil)) |
104 (ppid "PPID" "%d" right proced-< nil (ppid pid) | 104 (ppid "PPID" "%d" right proced-< nil (ppid pid) |
105 ((lambda (ppid) (proced-filter-parents proced-process-alist ppid)) . | 105 ((lambda (ppid) (proced-filter-parents proced-process-alist ppid)) |
106 "refine to process parents")) | 106 "refine to process parents")) |
107 (pgrp "PGRP" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) | 107 (pgrp "PGRP" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) |
108 (sess "SESS" "%d" right proced-< nil (sess pid) (nil t nil)) | 108 (sess "SESS" "%d" right proced-< nil (sess pid) (nil t nil)) |
109 (ttname "TTY" proced-format-ttname left proced-string-lessp nil (ttname pid) (nil t nil)) | 109 (ttname "TTY" proced-format-ttname left proced-string-lessp nil (ttname pid) (nil t nil)) |
110 (tpgid "TPGID" "%d" right proced-< nil (tpgid pid) (nil t nil)) | 110 (tpgid "TPGID" "%d" right proced-< nil (tpgid pid) (nil t nil)) |
112 (majflt "MAJFLT" "%d" right proced-< nil (majflt pid) (nil t t)) | 112 (majflt "MAJFLT" "%d" right proced-< nil (majflt pid) (nil t t)) |
113 (cminflt "CMINFLT" "%d" right proced-< nil (cminflt pid) (nil t t)) | 113 (cminflt "CMINFLT" "%d" right proced-< nil (cminflt pid) (nil t t)) |
114 (cmajflt "CMAJFLT" "%d" right proced-< nil (cmajflt pid) (nil t t)) | 114 (cmajflt "CMAJFLT" "%d" right proced-< nil (cmajflt pid) (nil t t)) |
115 (utime "UTIME" proced-format-time right proced-time-lessp t (utime pid) (nil t t)) | 115 (utime "UTIME" proced-format-time right proced-time-lessp t (utime pid) (nil t t)) |
116 (stime "STIME" proced-format-time right proced-time-lessp t (stime pid) (nil t t)) | 116 (stime "STIME" proced-format-time right proced-time-lessp t (stime pid) (nil t t)) |
117 (time "TIME" proced-format-time right proced-time-lessp t (time pid) (nil t t)) | |
117 (cutime "CUTIME" proced-format-time right proced-time-lessp t (cutime pid) (nil t t)) | 118 (cutime "CUTIME" proced-format-time right proced-time-lessp t (cutime pid) (nil t t)) |
118 (cstime "CSTIME" proced-format-time right proced-time-lessp t (cstime pid) (nil t t)) | 119 (cstime "CSTIME" proced-format-time right proced-time-lessp t (cstime pid) (nil t t)) |
120 (ctime "CTIME" proced-format-time right proced-time-lessp t (ctime pid) (nil t t)) | |
119 (pri "PR" "%d" right proced-< t (pri pid) (nil t t)) | 121 (pri "PR" "%d" right proced-< t (pri pid) (nil t t)) |
120 (nice "NI" "%3d" 3 proced-< t (nice pid) (t t nil)) | 122 (nice "NI" "%3d" 3 proced-< t (nice pid) (t t nil)) |
121 (thcount "THCOUNT" "%d" right proced-< t (thcount pid) (nil t t)) | 123 (thcount "THCOUNT" "%d" right proced-< t (thcount pid) (nil t t)) |
122 (start "START" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil)) | 124 (start "START" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil)) |
123 (vsize "VSIZE" "%d" right proced-< t (vsize pid) (nil t t)) | 125 (vsize "VSIZE" "%d" right proced-< t (vsize pid) (nil t t)) |
127 (pmem "%MEM" "%.1f" right proced-< t (pmem pid) (nil t t)) | 129 (pmem "%MEM" "%.1f" right proced-< t (pmem pid) (nil t t)) |
128 (args "ARGS" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) | 130 (args "ARGS" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) |
129 ;; | 131 ;; |
130 ;; attributes defined by proced (see `proced-process-attributes') | 132 ;; attributes defined by proced (see `proced-process-attributes') |
131 (pid "PID" "%d" right proced-< nil (pid) | 133 (pid "PID" "%d" right proced-< nil (pid) |
132 ((lambda (ppid) (proced-filter-children proced-process-alist ppid)) . | 134 ((lambda (ppid) (proced-filter-children proced-process-alist ppid)) |
133 "refine to process children")) | 135 "refine to process children")) |
134 ;; time: sum of utime and stime | |
135 (time "TIME" proced-format-time right proced-time-lessp t (time pid) (nil t t)) | |
136 ;; ctime: sum of cutime and cstime | |
137 (ctime "CTIME" proced-format-time right proced-time-lessp t (ctime pid) (nil t t)) | |
138 ;; process tree | 136 ;; process tree |
139 (tree "TREE" proced-format-tree left nil nil nil nil)) | 137 (tree "TREE" proced-format-tree left nil nil nil nil)) |
140 "Alist of rules for handling Proced attributes. | 138 "Alist of rules for handling Proced attributes. |
141 | 139 |
142 Each element has the form | 140 Each element has the form |
181 using PREDICATE. | 179 using PREDICATE. |
182 If PREDICATE yields non-nil, the process is accepted if LESS-B is non-nil. | 180 If PREDICATE yields non-nil, the process is accepted if LESS-B is non-nil. |
183 If PREDICATE yields 'equal, the process is accepted if EQUAL-B is non-nil. | 181 If PREDICATE yields 'equal, the process is accepted if EQUAL-B is non-nil. |
184 If PREDICATE yields nil, the process is accepted if LARGER-B is non-nil. | 182 If PREDICATE yields nil, the process is accepted if LARGER-B is non-nil. |
185 | 183 |
186 REFINER can also be a cons pair (FUNCTION . HELP-ECHO). | 184 REFINER can also be a list (FUNCTION HELP-ECHO). |
187 FUNCTION is called with one argument, the PID of the process at the position | 185 FUNCTION is called with one argument, the PID of the process at the position |
188 of point. The function must return a list of PIDs that is used for the refined | 186 of point. The function must return a list of PIDs that is used for the refined |
189 listing. HELP-ECHO is a string that is shown when mouse is over this field. | 187 listing. HELP-ECHO is a string that is shown when mouse is over this field. |
190 | 188 |
191 If REFINER is nil no refinement is done." | 189 If REFINER is nil no refinement is done." |
206 (function :tag "Function")) | 204 (function :tag "Function")) |
207 (boolean :tag "Descending Sort Order") | 205 (boolean :tag "Descending Sort Order") |
208 (repeat :tag "Sort Scheme" (symbol :tag "Key")) | 206 (repeat :tag "Sort Scheme" (symbol :tag "Key")) |
209 (choice :tag "Refiner" | 207 (choice :tag "Refiner" |
210 (const :tag "None" nil) | 208 (const :tag "None" nil) |
209 (list (function :tag "Refinement Function") | |
210 (string :tag "Help echo")) | |
211 (list :tag "Refine Flags" | 211 (list :tag "Refine Flags" |
212 (boolean :tag "Less") | 212 (boolean :tag "Less") |
213 (boolean :tag "Equal") | 213 (boolean :tag "Equal") |
214 (boolean :tag "Larger")) | 214 (boolean :tag "Larger")))))) |
215 (cons (function :tag "Refinement Function") | |
216 (string :tag "Help echo")))))) | |
217 | 215 |
218 (defcustom proced-custom-attributes nil | 216 (defcustom proced-custom-attributes nil |
219 "List of functions defining custom attributes. | 217 "List of functions defining custom attributes. |
220 This variable extends the functionality of `proced-process-attributes'. | 218 This variable extends the functionality of `proced-process-attributes'. |
221 Each function is called with one argument, the list of attributes | 219 Each function is called with one argument, the list of attributes |
349 "Non-nil for display of Proced buffer as process tree." | 347 "Non-nil for display of Proced buffer as process tree." |
350 :group 'proced | 348 :group 'proced |
351 :type 'boolean) | 349 :type 'boolean) |
352 (make-variable-buffer-local 'proced-tree-flag) | 350 (make-variable-buffer-local 'proced-tree-flag) |
353 | 351 |
352 (defcustom proced-post-display-hook nil | |
353 "Normal hook run after displaying or updating a Proced buffer. | |
354 May be used to adapt the window size via `fit-window-to-buffer'." | |
355 :type 'hook | |
356 :options '(fit-window-to-buffer) | |
357 :group 'proced) | |
358 | |
354 ;; Internal variables | 359 ;; Internal variables |
355 | 360 |
356 (defvar proced-available (not (null (list-system-processes))) | 361 (defvar proced-available (not (null (list-system-processes))) |
357 "Non-nil means Proced is known to work on this system.") | 362 "Non-nil means Proced is known to work on this system.") |
358 | 363 |
403 "Temporary alist (internal variable).") | 408 "Temporary alist (internal variable).") |
404 | 409 |
405 (defvar proced-process-tree nil | 410 (defvar proced-process-tree nil |
406 "Proced process tree (internal variable).") | 411 "Proced process tree (internal variable).") |
407 | 412 |
408 (defvar proced-tree-indent nil | 413 (defvar proced-tree-depth nil |
409 "Internal variable for indentation of Proced process tree.") | 414 "Internal variable for depth of Proced process tree.") |
410 | 415 |
411 (defvar proced-auto-update-timer nil | 416 (defvar proced-auto-update-timer nil |
412 "Stores if Proced auto update timer is already installed.") | 417 "Stores if Proced auto update timer is already installed.") |
413 | 418 |
414 (defvar proced-log-buffer "*Proced log*" | 419 (defvar proced-log-buffer "*Proced log*" |
476 ;; operate | 481 ;; operate |
477 (define-key km "o" 'proced-omit-processes) | 482 (define-key km "o" 'proced-omit-processes) |
478 (define-key km "x" 'proced-send-signal) ; Dired compatibility | 483 (define-key km "x" 'proced-send-signal) ; Dired compatibility |
479 (define-key km "k" 'proced-send-signal) ; kill processes | 484 (define-key km "k" 'proced-send-signal) ; kill processes |
480 ;; misc | 485 ;; misc |
481 (define-key km "g" 'revert-buffer) ; Dired compatibility | |
482 (define-key km "h" 'describe-mode) | 486 (define-key km "h" 'describe-mode) |
483 (define-key km "?" 'proced-help) | 487 (define-key km "?" 'proced-help) |
484 (define-key km "q" 'quit-window) | |
485 (define-key km [remap undo] 'proced-undo) | 488 (define-key km [remap undo] 'proced-undo) |
486 (define-key km [remap advertised-undo] 'proced-undo) | 489 (define-key km [remap advertised-undo] 'proced-undo) |
490 ;; Additional keybindings are inherited from `special-mode-map' | |
487 km) | 491 km) |
488 "Keymap for Proced commands.") | 492 "Keymap for Proced commands.") |
489 | 493 |
490 (easy-menu-define | 494 (easy-menu-define |
491 proced-menu proced-mode-map "Proced Menu" | 495 proced-menu proced-mode-map "Proced Menu" |
592 (if (looking-at "^. .") | 596 (if (looking-at "^. .") |
593 (get-text-property (match-end 0) 'proced-pid)))) | 597 (get-text-property (match-end 0) 'proced-pid)))) |
594 | 598 |
595 ;; proced mode | 599 ;; proced mode |
596 | 600 |
597 (define-derived-mode proced-mode nil "Proced" | 601 (define-derived-mode proced-mode special-mode "Proced" |
598 "Mode for displaying UNIX system processes and sending signals to them. | 602 "Mode for displaying UNIX system processes and sending signals to them. |
599 Type \\[proced] to start a Proced session. In a Proced buffer | 603 Type \\[proced] to start a Proced session. In a Proced buffer |
600 type \\<proced-mode-map>\\[proced-mark] to mark a process for later commands. | 604 type \\<proced-mode-map>\\[proced-mark] to mark a process for later commands. |
601 Type \\[proced-send-signal] to send signals to marked processes. | 605 Type \\[proced-send-signal] to send signals to marked processes. |
602 | 606 |
620 An existing Proced listing can be refined by typing \\[proced-refine]. | 624 An existing Proced listing can be refined by typing \\[proced-refine]. |
621 Refining an existing listing does not update the variable `proced-filter'. | 625 Refining an existing listing does not update the variable `proced-filter'. |
622 | 626 |
623 The attribute-specific rules for formatting, filtering, sorting, and refining | 627 The attribute-specific rules for formatting, filtering, sorting, and refining |
624 are defined in `proced-grammar-alist'. | 628 are defined in `proced-grammar-alist'. |
629 | |
630 After displaying or updating a Proced buffer, Proced runs the normal hook | |
631 `proced-post-display-hook'. | |
625 | 632 |
626 \\{proced-mode-map}" | 633 \\{proced-mode-map}" |
627 (abbrev-mode 0) | 634 (abbrev-mode 0) |
628 (auto-fill-mode 0) | 635 (auto-fill-mode 0) |
629 (setq buffer-read-only t | 636 (setq buffer-read-only t |
636 (if (and (not proced-auto-update-timer) proced-auto-update-interval) | 643 (if (and (not proced-auto-update-timer) proced-auto-update-interval) |
637 (setq proced-auto-update-timer | 644 (setq proced-auto-update-timer |
638 (run-at-time t proced-auto-update-interval | 645 (run-at-time t proced-auto-update-interval |
639 'proced-auto-update-timer)))) | 646 'proced-auto-update-timer)))) |
640 | 647 |
641 ;; Proced mode is suitable only for specially formatted data. | |
642 (put 'proced-mode 'mode-class 'special) | |
643 | |
644 ;;;###autoload | 648 ;;;###autoload |
645 (defun proced (&optional arg) | 649 (defun proced (&optional arg) |
646 "Generate a listing of UNIX system processes. | 650 "Generate a listing of UNIX system processes. |
647 If invoked with optional ARG the window displaying the process | 651 If invoked with optional ARG the window displaying the process |
648 information will be displayed but not selected. | 652 information will be displayed but not selected. |
653 Runs the normal hook `proced-post-display-hook'. | |
649 | 654 |
650 See `proced-mode' for a description of features available in Proced buffers." | 655 See `proced-mode' for a description of features available in Proced buffers." |
651 (interactive "P") | 656 (interactive "P") |
652 (unless proced-available | 657 (unless proced-available |
653 (error "Proced is not available on this system")) | 658 (error "Proced is not available on this system")) |
654 (let ((buffer (get-buffer-create "*Proced*")) new) | 659 (let ((buffer (get-buffer-create "*Proced*")) new) |
655 (set-buffer buffer) | 660 (set-buffer buffer) |
656 (setq new (zerop (buffer-size))) | 661 (setq new (zerop (buffer-size))) |
657 (if new (proced-mode)) | 662 (when new |
658 (if (or new arg) | 663 (proced-mode) |
659 (proced-update t)) | 664 ;; `proced-update' runs `proced-post-display-hook' only if the |
665 ;; Proced buffer has been selected. Yet the following call of | |
666 ;; `proced-update' is for an empty Proced buffer that has not | |
667 ;; yet been selected. Therefore we need to call | |
668 ;; `proced-post-display-hook' below. | |
669 (proced-update t)) | |
660 (if arg | 670 (if arg |
661 (display-buffer buffer) | 671 (progn |
672 (display-buffer buffer) | |
673 (with-current-buffer buffer | |
674 (run-hooks 'proced-post-display-hook))) | |
662 (pop-to-buffer buffer) | 675 (pop-to-buffer buffer) |
676 (run-hooks 'proced-post-display-hook) | |
663 (message | 677 (message |
664 (substitute-command-keys | 678 (substitute-command-keys |
665 "Type \\<proced-mode-map>\\[quit-window] to quit, \\[proced-help] for help"))))) | 679 "Type \\<proced-mode-map>\\[quit-window] to quit, \\[proced-help] for help"))))) |
666 | 680 |
667 (defun proced-auto-update-timer () | 681 (defun proced-auto-update-timer () |
683 (arg (> (prefix-numeric-value arg) 0)) | 697 (arg (> (prefix-numeric-value arg) 0)) |
684 (t (not proced-auto-update-flag)))) | 698 (t (not proced-auto-update-flag)))) |
685 (message "Proced auto update %s" | 699 (message "Proced auto update %s" |
686 (if proced-auto-update-flag "enabled" "disabled"))) | 700 (if proced-auto-update-flag "enabled" "disabled"))) |
687 | 701 |
702 ;;; Mark | |
703 | |
688 (defun proced-mark (&optional count) | 704 (defun proced-mark (&optional count) |
689 "Mark the current (or next COUNT) processes." | 705 "Mark the current (or next COUNT) processes." |
690 (interactive "p") | 706 (interactive "p") |
691 (proced-do-mark t count)) | 707 (proced-do-mark t count)) |
692 | 708 |
712 (beginning-of-line) | 728 (beginning-of-line) |
713 (while (not (or (zerop (setq count (1- count))) (eobp))) | 729 (while (not (or (zerop (setq count (1- count))) (eobp))) |
714 (proced-insert-mark mark backward)) | 730 (proced-insert-mark mark backward)) |
715 (proced-move-to-goal-column))) | 731 (proced-move-to-goal-column))) |
716 | 732 |
733 (defun proced-toggle-marks () | |
734 "Toggle marks: marked processes become unmarked, and vice versa." | |
735 (interactive) | |
736 (let ((mark-re (proced-marker-regexp)) | |
737 buffer-read-only) | |
738 (save-excursion | |
739 (goto-char (point-min)) | |
740 (while (not (eobp)) | |
741 (cond ((looking-at mark-re) | |
742 (proced-insert-mark nil)) | |
743 ((looking-at " ") | |
744 (proced-insert-mark t)) | |
745 (t | |
746 (forward-line 1))))))) | |
747 | |
748 (defun proced-insert-mark (mark &optional backward) | |
749 "If MARK is non-nil, insert `proced-marker-char'. | |
750 If BACKWARD is non-nil, move one line backwards before inserting the mark. | |
751 Otherwise move one line forward after inserting the mark." | |
752 (if backward (forward-line -1)) | |
753 (insert (if mark proced-marker-char ?\s)) | |
754 (delete-char 1) | |
755 (unless backward (forward-line))) | |
756 | |
717 (defun proced-mark-all () | 757 (defun proced-mark-all () |
718 "Mark all processes. | 758 "Mark all processes. |
719 If `transient-mark-mode' is turned on and the region is active, | 759 If `transient-mark-mode' is turned on and the region is active, |
720 mark the region." | 760 mark the region." |
721 (interactive) | 761 (interactive) |
730 | 770 |
731 (defun proced-do-mark-all (mark) | 771 (defun proced-do-mark-all (mark) |
732 "Mark all processes using MARK. | 772 "Mark all processes using MARK. |
733 If `transient-mark-mode' is turned on and the region is active, | 773 If `transient-mark-mode' is turned on and the region is active, |
734 mark the region." | 774 mark the region." |
735 (let ((count 0) end buffer-read-only) | 775 (let* ((count 0) |
776 (proced-marker-char (if mark proced-marker-char ?\s)) | |
777 (marker-re (proced-marker-regexp)) | |
778 end buffer-read-only) | |
736 (save-excursion | 779 (save-excursion |
737 (if (use-region-p) | 780 (if (use-region-p) |
738 ;; Operate even on those lines that are only partially a part | 781 ;; Operate even on those lines that are only partially a part |
739 ;; of region. This appears most consistent with | 782 ;; of region. This appears most consistent with |
740 ;; `proced-move-to-goal-column'. | 783 ;; `proced-move-to-goal-column'. |
745 (goto-char (region-beginning)) | 788 (goto-char (region-beginning)) |
746 (unless (looking-at "^") (beginning-of-line))) | 789 (unless (looking-at "^") (beginning-of-line))) |
747 (goto-char (point-min)) | 790 (goto-char (point-min)) |
748 (setq end (point-max))) | 791 (setq end (point-max))) |
749 (while (< (point) end) | 792 (while (< (point) end) |
750 (setq count (1+ count)) | 793 (unless (looking-at marker-re) |
751 (proced-insert-mark mark)) | 794 (setq count (1+ count)) |
752 (proced-success-message "Marked" count)))) | 795 (insert proced-marker-char) |
753 | 796 (delete-char 1)) |
754 (defun proced-toggle-marks () | 797 (forward-line)) |
755 "Toggle marks: marked processes become unmarked, and vice versa." | 798 (proced-success-message (if mark "Marked" "Unmarked") count)))) |
756 (interactive) | |
757 (let ((mark-re (proced-marker-regexp)) | |
758 buffer-read-only) | |
759 (save-excursion | |
760 (goto-char (point-min)) | |
761 (while (not (eobp)) | |
762 (cond ((looking-at mark-re) | |
763 (proced-insert-mark nil)) | |
764 ((looking-at " ") | |
765 (proced-insert-mark t)) | |
766 (t | |
767 (forward-line 1))))))) | |
768 | |
769 (defun proced-insert-mark (mark &optional backward) | |
770 "If MARK is non-nil, insert `proced-marker-char'. | |
771 If BACKWARD is non-nil, move one line backwards before inserting the mark. | |
772 Otherwise move one line forward after inserting the mark." | |
773 (if backward (forward-line -1)) | |
774 (insert (if mark proced-marker-char ?\s)) | |
775 (delete-char 1) | |
776 (unless backward (forward-line))) | |
777 | 799 |
778 (defun proced-mark-children (ppid &optional omit-ppid) | 800 (defun proced-mark-children (ppid &optional omit-ppid) |
779 "Mark child processes of process PPID. | 801 "Mark child processes of process PPID. |
780 Also mark process PPID unless prefix OMIT-PPID is non-nil." | 802 Also mark process PPID unless prefix OMIT-PPID is non-nil." |
781 (interactive (list (proced-pid-at-point) current-prefix-arg)) | 803 (interactive (list (proced-pid-at-point) current-prefix-arg)) |
1024 If `proced-tree-flag' is nil, remove the tree attribute. | 1046 If `proced-tree-flag' is nil, remove the tree attribute. |
1025 Return the rearranged process list." | 1047 Return the rearranged process list." |
1026 (if proced-tree-flag | 1048 (if proced-tree-flag |
1027 ;; add tree attribute | 1049 ;; add tree attribute |
1028 (let ((process-tree (proced-process-tree process-alist)) | 1050 (let ((process-tree (proced-process-tree process-alist)) |
1029 (proced-tree-indent 0) | 1051 (proced-tree-depth 0) |
1030 (proced-temp-alist process-alist) | 1052 (proced-temp-alist process-alist) |
1031 proced-process-tree pt) | 1053 proced-process-tree pt) |
1032 (while (setq pt (pop process-tree)) | 1054 (while (setq pt (pop process-tree)) |
1033 (proced-tree-insert pt)) | 1055 (proced-tree-insert pt)) |
1034 (nreverse proced-process-tree)) | 1056 (nreverse proced-process-tree)) |
1042 | 1064 |
1043 (defun proced-tree-insert (process-tree) | 1065 (defun proced-tree-insert (process-tree) |
1044 "Helper function for `proced-tree'." | 1066 "Helper function for `proced-tree'." |
1045 (let ((pprocess (assq (car process-tree) proced-temp-alist))) | 1067 (let ((pprocess (assq (car process-tree) proced-temp-alist))) |
1046 (push (append (list (car pprocess)) | 1068 (push (append (list (car pprocess)) |
1047 (list (cons 'tree proced-tree-indent)) | 1069 (list (cons 'tree proced-tree-depth)) |
1048 (cdr pprocess)) | 1070 (cdr pprocess)) |
1049 proced-process-tree) | 1071 proced-process-tree) |
1050 (if (cdr process-tree) | 1072 (if (cdr process-tree) |
1051 (let ((proced-tree-indent (1+ proced-tree-indent))) | 1073 (let ((proced-tree-depth (1+ proced-tree-depth))) |
1052 (mapc 'proced-tree-insert (cdr process-tree)))))) | 1074 (mapc 'proced-tree-insert (cdr process-tree)))))) |
1053 | 1075 |
1054 ;; Refining | 1076 ;; Refining |
1055 | 1077 |
1056 ;; Filters are used to select the processes in a new listing. | 1078 ;; Filters are used to select the processes in a new listing. |
1359 ;; If none of the alternatives is non-nil, the attribute is ignored | 1381 ;; If none of the alternatives is non-nil, the attribute is ignored |
1360 ;; in the listing. | 1382 ;; in the listing. |
1361 (let ((standard-attributes | 1383 (let ((standard-attributes |
1362 (car (proced-process-attributes (list (emacs-pid))))) | 1384 (car (proced-process-attributes (list (emacs-pid))))) |
1363 new-format fmi) | 1385 new-format fmi) |
1364 (if proced-tree-flag (push (cons 'tree 0) standard-attributes)) | 1386 (if (and proced-tree-flag |
1387 (assq 'ppid standard-attributes)) | |
1388 (push (cons 'tree 0) standard-attributes)) | |
1365 (dolist (fmt format) | 1389 (dolist (fmt format) |
1366 (if (symbolp fmt) | 1390 (if (symbolp fmt) |
1367 (if (assq fmt standard-attributes) | 1391 (if (assq fmt standard-attributes) |
1368 (push fmt new-format)) | 1392 (push fmt new-format)) |
1369 (while (setq fmi (pop fmt)) | 1393 (while (setq fmi (pop fmt)) |
1400 (refiner (nth 7 grammar)) | 1424 (refiner (nth 7 grammar)) |
1401 (fprops | 1425 (fprops |
1402 (cond ((functionp (car refiner)) | 1426 (cond ((functionp (car refiner)) |
1403 `(proced-key ,key mouse-face highlight | 1427 `(proced-key ,key mouse-face highlight |
1404 help-echo ,(format "mouse-2, RET: %s" | 1428 help-echo ,(format "mouse-2, RET: %s" |
1405 (cdr refiner)))) | 1429 (nth 1 refiner)))) |
1406 ((consp refiner) | 1430 ((consp refiner) |
1407 `(proced-key ,key mouse-face highlight | 1431 `(proced-key ,key mouse-face highlight |
1408 help-echo ,(format "mouse-2, RET: refine by attribute %s %s" | 1432 help-echo ,(format "mouse-2, RET: refine by attribute %s %s" |
1409 (nth 1 grammar) | 1433 (nth 1 grammar) |
1410 (mapconcat (lambda (s) | 1434 (mapconcat (lambda (s) |
1502 Optional arg PID-LIST is a list of PIDs of system process that are analyzed. | 1526 Optional arg PID-LIST is a list of PIDs of system process that are analyzed. |
1503 If no attributes are known for a process (possibly because it already died) | 1527 If no attributes are known for a process (possibly because it already died) |
1504 the process is ignored." | 1528 the process is ignored." |
1505 ;; Should we make it customizable whether processes with empty attribute | 1529 ;; Should we make it customizable whether processes with empty attribute |
1506 ;; lists are ignored? When would such processes be of interest? | 1530 ;; lists are ignored? When would such processes be of interest? |
1507 (let (process-alist attributes) | 1531 (let (process-alist attributes attr) |
1508 (dolist (pid (or pid-list (list-system-processes)) process-alist) | 1532 (dolist (pid (or pid-list (list-system-processes)) process-alist) |
1509 (when (setq attributes (system-process-attributes pid)) | 1533 (when (setq attributes (system-process-attributes pid)) |
1510 (let ((utime (cdr (assq 'utime attributes))) | 1534 (setq attributes (cons (cons 'pid pid) attributes)) |
1511 (stime (cdr (assq 'stime attributes))) | 1535 (dolist (fun proced-custom-attributes) |
1512 (cutime (cdr (assq 'cutime attributes))) | 1536 (if (setq attr (funcall fun attributes)) |
1513 (cstime (cdr (assq 'cstime attributes))) | 1537 (push attr attributes))) |
1514 attr) | 1538 (push (cons pid attributes) process-alist))))) |
1515 (setq attributes | |
1516 (append (list (cons 'pid pid)) | |
1517 (if (and utime stime) | |
1518 (list (cons 'time (time-add utime stime)))) | |
1519 (if (and cutime cstime) | |
1520 (list (cons 'ctime (time-add cutime cstime)))) | |
1521 attributes)) | |
1522 (dolist (fun proced-custom-attributes) | |
1523 (if (setq attr (funcall fun attributes)) | |
1524 (push attr attributes))) | |
1525 (push (cons pid attributes) process-alist)))))) | |
1526 | 1539 |
1527 (defun proced-update (&optional revert quiet) | 1540 (defun proced-update (&optional revert quiet) |
1528 "Update the Proced process information. Preserves point and marks. | 1541 "Update the Proced process information. Preserves point and marks. |
1529 With prefix REVERT non-nil, revert listing. | 1542 With prefix REVERT non-nil, revert listing. |
1530 Suppress status information if QUIET is nil." | 1543 Suppress status information if QUIET is nil. |
1544 After updating a displayed Proced buffer run the normal hook | |
1545 `proced-post-display-hook'." | |
1531 ;; This is the main function that generates and updates the process listing. | 1546 ;; This is the main function that generates and updates the process listing. |
1532 (interactive "P") | 1547 (interactive "P") |
1533 (setq revert (or revert (not proced-process-alist))) | 1548 (setq revert (or revert (not proced-process-alist))) |
1534 (or quiet (message (if revert "Updating process information..." | 1549 (or quiet (message (if revert "Updating process information..." |
1535 "Updating process display..."))) | 1550 "Updating process display..."))) |
1641 (grammar (assq key proced-grammar-alist))) | 1656 (grammar (assq key proced-grammar-alist))) |
1642 (concat " by " (if proced-descend "-" "+") | 1657 (concat " by " (if proced-descend "-" "+") |
1643 (nth 1 grammar))) | 1658 (nth 1 grammar))) |
1644 ""))) | 1659 ""))) |
1645 (force-mode-line-update) | 1660 (force-mode-line-update) |
1661 ;; run `proced-post-display-hook' only for a displayed buffer. | |
1662 (if (get-buffer-window) (run-hooks 'proced-post-display-hook)) | |
1646 ;; done | 1663 ;; done |
1647 (or quiet (input-pending-p) | 1664 (or quiet (input-pending-p) |
1648 (message (if revert "Updating process information...done." | 1665 (message (if revert "Updating process information...done." |
1649 "Updating process display...done."))))) | 1666 "Updating process display...done."))))) |
1650 | 1667 |
1651 (defun proced-revert (&rest args) | 1668 (defun proced-revert (&rest args) |
1652 "Reevaluate the process listing based on the currently running processes. | 1669 "Reevaluate the process listing based on the currently running processes. |
1653 Preserves point and marks." | 1670 Preserves point and marks." |
1654 (proced-update t)) | 1671 (proced-update t)) |
1655 | 1672 |
1656 ;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer' | |
1657 ;; and move it to window.el so that proced and ibuffer can easily use it, too? | |
1658 ;; What about functions like `appt-disp-window' that use | |
1659 ;; `shrink-window-if-larger-than-buffer'? | |
1660 (autoload 'dired-pop-to-buffer "dired") | |
1661 | |
1662 (defun proced-send-signal (&optional signal) | 1673 (defun proced-send-signal (&optional signal) |
1663 "Send a SIGNAL to the marked processes. | 1674 "Send a SIGNAL to the marked processes. |
1664 If no process is marked, operate on current process. | 1675 If no process is marked, operate on current process. |
1665 SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. | 1676 SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. |
1666 If SIGNAL is nil display marked processes and query interactively for SIGNAL." | 1677 If SIGNAL is nil display marked processes and query interactively for SIGNAL. |
1678 After sending the signal, this command runs the normal hook | |
1679 `proced-after-send-signal-hook'." | |
1667 (interactive) | 1680 (interactive) |
1668 (let ((regexp (proced-marker-regexp)) | 1681 (let ((regexp (proced-marker-regexp)) |
1669 process-alist) | 1682 process-alist) |
1670 ;; collect marked processes | 1683 ;; collect marked processes |
1671 (save-excursion | 1684 (save-excursion |
1672 (goto-char (point-min)) | 1685 (goto-char (point-min)) |
1673 (while (re-search-forward regexp nil t) | 1686 (while (re-search-forward regexp nil t) |
1674 (push (cons (proced-pid-at-point) | 1687 (push (cons (proced-pid-at-point) |
1675 ;; How much info should we collect here? | 1688 ;; How much info should we collect here? |
1676 (substring (match-string-no-properties 0) 2)) | 1689 (buffer-substring-no-properties |
1690 (+ 2 (line-beginning-position)) | |
1691 (line-end-position))) | |
1677 process-alist))) | 1692 process-alist))) |
1678 (setq process-alist | 1693 (setq process-alist |
1679 (if process-alist | 1694 (if process-alist |
1680 (nreverse process-alist) | 1695 (nreverse process-alist) |
1681 ;; take current process | 1696 ;; take current process |
1694 (add-hook 'post-command-hook 'force-mode-line-update nil t) | 1709 (add-hook 'post-command-hook 'force-mode-line-update nil t) |
1695 (erase-buffer) | 1710 (erase-buffer) |
1696 (dolist (process process-alist) | 1711 (dolist (process process-alist) |
1697 (insert " " (cdr process) "\n")) | 1712 (insert " " (cdr process) "\n")) |
1698 (save-window-excursion | 1713 (save-window-excursion |
1699 (dired-pop-to-buffer bufname) ; all we need | 1714 (pop-to-buffer (current-buffer)) |
1715 (fit-window-to-buffer (get-buffer-window) nil 1) | |
1700 (let* ((completion-ignore-case t) | 1716 (let* ((completion-ignore-case t) |
1701 (pnum (if (= 1 (length process-alist)) | 1717 (pnum (if (= 1 (length process-alist)) |
1702 "1 process" | 1718 "1 process" |
1703 (format "%d processes" (length process-alist)))) | 1719 (format "%d processes" (length process-alist)))) |
1704 ;; The following is an ugly hack. Is there a better way | 1720 ;; The following is an ugly hack. Is there a better way |
1727 (if (zerop (funcall | 1743 (if (zerop (funcall |
1728 proced-signal-function (car process) signal)) | 1744 proced-signal-function (car process) signal)) |
1729 (setq count (1+ count)) | 1745 (setq count (1+ count)) |
1730 (proced-log "%s\n" (cdr process)) | 1746 (proced-log "%s\n" (cdr process)) |
1731 (push (cdr process) failures)) | 1747 (push (cdr process) failures)) |
1732 (error ;; catch errors from failed signals | 1748 (error ; catch errors from failed signals |
1733 (proced-log "%s\n" err) | 1749 (proced-log "%s\n" err) |
1734 (proced-log "%s\n" (cdr process)) | 1750 (proced-log "%s\n" (cdr process)) |
1735 (push (cdr process) failures))))) | 1751 (push (cdr process) failures))))) |
1736 ;; use external system call | 1752 ;; use external system call |
1737 (let ((signal (concat "-" (if (numberp signal) | 1753 (let ((signal (concat "-" (if (numberp signal) |
1744 signal (number-to-string (car process)))) | 1760 signal (number-to-string (car process)))) |
1745 (setq count (1+ count)) | 1761 (setq count (1+ count)) |
1746 (proced-log (current-buffer)) | 1762 (proced-log (current-buffer)) |
1747 (proced-log "%s\n" (cdr process)) | 1763 (proced-log "%s\n" (cdr process)) |
1748 (push (cdr process) failures)) | 1764 (push (cdr process) failures)) |
1749 (error ;; catch errors from failed signals | 1765 (error ; catch errors from failed signals |
1750 (proced-log (current-buffer)) | 1766 (proced-log (current-buffer)) |
1751 (proced-log "%s\n" (cdr process)) | 1767 (proced-log "%s\n" (cdr process)) |
1752 (push (cdr process) failures))))))) | 1768 (push (cdr process) failures))))))) |
1753 (if failures | 1769 (if failures |
1754 ;; Proced error message are not always very precise. | 1770 ;; Proced error message are not always very precise. |