From 2d16b285e34db3aae3c9325301ac0277352077dd Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Mon, 6 Feb 2012 22:40:10 +0800 Subject: [PATCH] * simple.el (list-processes--refresh): Delete exited processes. Fixes: debbugs:8094 --- lisp/ChangeLog | 3 ++ lisp/simple.el | 81 ++++++++++++++++++++++++++------------------------ 2 files changed, 45 insertions(+), 39 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 27c914b0424..46849087958 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2012-02-06 Chong Yidong + * simple.el (list-processes--refresh): Delete exited processes + (Bug#8094). + * comint.el (comint-next-prompt): next-single-char-property-change and prev-single-char-property-change never return nil (Bug#8657). diff --git a/lisp/simple.el b/lisp/simple.el index 8bd32a8db8d..610d4a3be42 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2713,47 +2713,50 @@ support pty association, if PROGRAM is nil." (tabulated-list-init-header)) (defun list-processes--refresh () - "Recompute the list of processes for the Process List buffer." + "Recompute the list of processes for the Process List buffer. +Also, delete any process that is exited or signaled." (setq tabulated-list-entries nil) (dolist (p (process-list)) - (when (or (not process-menu-query-only) - (process-query-on-exit-flag p)) - (let* ((buf (process-buffer p)) - (type (process-type p)) - (name (process-name p)) - (status (symbol-name (process-status p))) - (buf-label (if (buffer-live-p buf) - `(,(buffer-name buf) - face link - help-echo ,(concat "Visit buffer `" - (buffer-name buf) "'") - follow-link t - process-buffer ,buf - action process-menu-visit-buffer) - "--")) - (tty (or (process-tty-name p) "--")) - (cmd - (if (memq type '(network serial)) - (let ((contact (process-contact p t))) - (if (eq type 'network) - (format "(%s %s)" - (if (plist-get contact :type) - "datagram" - "network") - (if (plist-get contact :server) - (format "server on %s" - (plist-get contact :server)) - (format "connection to %s" - (plist-get contact :host)))) - (format "(serial port %s%s)" - (or (plist-get contact :port) "?") - (let ((speed (plist-get contact :speed))) - (if speed - (format " at %s b/s" speed) - ""))))) - (mapconcat 'identity (process-command p) " ")))) - (push (list p (vector name status buf-label tty cmd)) - tabulated-list-entries))))) + (cond ((memq (process-status p) '(exit signal closed)) + (delete-process p)) + ((or (not process-menu-query-only) + (process-query-on-exit-flag p)) + (let* ((buf (process-buffer p)) + (type (process-type p)) + (name (process-name p)) + (status (symbol-name (process-status p))) + (buf-label (if (buffer-live-p buf) + `(,(buffer-name buf) + face link + help-echo ,(concat "Visit buffer `" + (buffer-name buf) "'") + follow-link t + process-buffer ,buf + action process-menu-visit-buffer) + "--")) + (tty (or (process-tty-name p) "--")) + (cmd + (if (memq type '(network serial)) + (let ((contact (process-contact p t))) + (if (eq type 'network) + (format "(%s %s)" + (if (plist-get contact :type) + "datagram" + "network") + (if (plist-get contact :server) + (format "server on %s" + (plist-get contact :server)) + (format "connection to %s" + (plist-get contact :host)))) + (format "(serial port %s%s)" + (or (plist-get contact :port) "?") + (let ((speed (plist-get contact :speed))) + (if speed + (format " at %s b/s" speed) + ""))))) + (mapconcat 'identity (process-command p) " ")))) + (push (list p (vector name status buf-label tty cmd)) + tabulated-list-entries)))))) (defun process-menu-visit-buffer (button) (display-buffer (button-get button 'process-buffer))) -- 2.39.2