Reimplement list-processes in Lisp.

* lisp/simple.el: Lisp reimplement of list-processes.  Based on an
earlier reimplementation by Leo Liu, but using tabulated-list.el.
(process-menu-mode): New major mode.
(list-processes--refresh, list-processes):
(process-menu-visit-buffer): New functions.

* lisp/files.el (save-buffers-kill-emacs): Don't assume any return
value of list-processes, which is undocumented anyway.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 313b2e94a309c302a641c3d2b56f836db7a1cf02..b09313ddda018c1c9f89d185f6e90ce389c62075 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2011-04-06  Chong Yidong  <cyd@stupidchicken.com>
+
+       * simple.el: Lisp reimplement of list-processes.  Based on an
+       earlier reimplementation by Leo Liu, but using tabulated-list.el.
+       (process-menu-mode): New major mode.
+       (list-processes--refresh, list-processes):
+       (process-menu-visit-buffer): New functions.
+
+       * files.el (save-buffers-kill-emacs): Don't assume any return
+       value of list-processes, which is undocumented anyway.
+
 2011-04-06  Chong Yidong  <cyd@stupidchicken.com>
 
        * emacs-lisp/tabulated-list.el: New file.

diff --git a/lisp/files.el b/lisp/files.el
index 6bfb4f00d32d7dfc730005fa3d0ac55ed7f68f03..7d8f3ee450381f33befdc80a36253acb5ba542cd 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6146,8 +6146,8 @@ With prefix ARG, silently save all file-visiting buffers, then kill."
                    (setq active t))
               (setq processes (cdr processes)))
             (or (not active)
-                (list-processes t)
-                (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
+                (progn (list-processes t)
+                       (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))))
        ;; Query the user for other things, perhaps.
        (run-hook-with-args-until-failure 'kill-emacs-query-functions)
        (or (null confirm-kill-emacs)

diff --git a/lisp/simple.el b/lisp/simple.el
index a414fc77a392481c0c90d3c0445f9e7692f53330..a9a5b50283b1d551b125cc73679a2ca3f096f58c 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2690,7 +2690,93 @@ support pty association, if PROGRAM is nil."
   (let ((fh (find-file-name-handler default-directory 'start-file-process)))
     (if fh (apply fh 'start-file-process name buffer program program-args)
       (apply 'start-process name buffer program program-args))))
-
+\f
+;;;; Process menu
+
+(defvar tabulated-list-format)
+(defvar tabulated-list-entries)
+(defvar tabulated-list-sort-key)
+(declare-function tabulated-list-init-header  "tabulated-list" ())
+(declare-function tabulated-list-print "tabulated-list" ())
+
+(defvar process-menu-query-only nil)
+
+(define-derived-mode process-menu-mode tabulated-list-mode "Process Menu"
+  "Major mode for listing the processes called by Emacs."
+  (setq tabulated-list-format [("Process" 15 t)
+                              ("Status"   7 t)
+                              ("Buffer"  15 t)
+                              ("TTY"     12 t)
+                              ("Command"  0 t)])
+  (make-local-variable 'process-menu-query-only)
+  (setq tabulated-list-sort-key (cons "Process" nil))
+  (add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t)
+  (tabulated-list-init-header))
+
+(defun list-processes--refresh ()
+  "Recompute the list of processes for the Process List buffer."
+  (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)))))
+
+(defun process-menu-visit-buffer (button)
+  (display-buffer (button-get button 'process-buffer)))
+
+(defun list-processes (&optional query-only buffer)
+  "Display a list of all processes.
+If optional argument QUERY-ONLY is non-nil, only processes with
+the query-on-exit flag set are listed.
+Any process listed as exited or signaled is actually eliminated
+after the listing is made.
+Optional argument BUFFER specifies a buffer to use, instead of
+\"*Process List\".
+The return value is always nil."
+  (interactive)
+  (unless (bufferp buffer)
+    (setq buffer (get-buffer-create "*Process List*")))
+  (with-current-buffer buffer
+    (process-menu-mode)
+    (setq process-menu-query-only query-only)
+    (list-processes--refresh)
+    (tabulated-list-print))
+  (display-buffer buffer))
 \f
 (defvar universal-argument-map
   (let ((map (make-sparse-keymap)))