From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Chong Yidong Newsgroups: gmane.emacs.devel Subject: list-processes reimplementation, and list/menu buffers Date: Sun, 03 Apr 2011 20:48:56 -0400 Message-ID: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: dough.gmane.org 1301878161 21018 80.91.229.12 (4 Apr 2011 00:49:21 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Mon, 4 Apr 2011 00:49:21 +0000 (UTC) Cc: emacs-devel@gnu.org To: Leo Liu Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Apr 04 02:49:12 2011 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Q6Xyc-0005hl-EH for ged-emacs-devel@m.gmane.org; Mon, 04 Apr 2011 02:49:11 +0200 Original-Received: from localhost ([127.0.0.1]:40558 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Q6Xya-0006Nj-9q for ged-emacs-devel@m.gmane.org; Sun, 03 Apr 2011 20:49:04 -0400 Original-Received: from [140.186.70.92] (port=59920 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Q6XyU-0006Ne-Oj for emacs-devel@gnu.org; Sun, 03 Apr 2011 20:49:00 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Q6XyT-0004H4-0W for emacs-devel@gnu.org; Sun, 03 Apr 2011 20:48:58 -0400 Original-Received: from fencepost.gnu.org ([140.186.70.10]:52580) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Q6XyS-0004H0-TQ for emacs-devel@gnu.org; Sun, 03 Apr 2011 20:48:56 -0400 Original-Received: from cyd by fencepost.gnu.org with local (Exim 4.71) (envelope-from ) id 1Q6XyS-0003ZL-MN; Sun, 03 Apr 2011 20:48:56 -0400 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 140.186.70.10 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:138093 Archived-At: I took a look at the list-processes reimplementation. It looks OK, but there's no real reason we should display the same buffer contents as the old list-processes. Instead, it seems to make sense to provide something similar to the list-packages and list-buffers interface. I took some code from your emacs-process.el, and reworked it using the list-packages code from package.el. Unlike emacs-process.el, this doesn't use the CL package, so it can be added to simple.el. However, it would be cleaner to make a new `list-menu-mode' major mode, usable for general "list of stuff" buffers. Then both the list-packages and list-processes can derive from that major mode. With a bit more work, list-buffers could use it too. I will investigate this approach. === modified file 'lisp/simple.el' *** lisp/simple.el 2011-03-31 04:24:03 +0000 --- lisp/simple.el 2011-04-04 00:16:17 +0000 *************** *** 2692,2697 **** --- 2692,2851 ---- (apply 'start-process name buffer program program-args)))) + (defvar process-menu-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-k" 'process-menu-delete) + (define-key map " " 'next-line) + (define-key map "n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "g" 'revert-buffer) + map) + "Keymap for `process-menu-mode'.") + + (defvar process-menu--query-only nil) + + (define-derived-mode process-menu-mode special-mode "Process List" + "Major mode for the buffer created by `list-processes'." + (setq truncate-lines t) + (setq buffer-read-only t) + (set (make-local-variable 'revert-buffer-function) 'list-processes-revert) + (setq header-line-format + (mapconcat + (lambda (pair) + (let ((column (car pair)) + (name (cdr pair))) + (concat + ;; Insert a space that aligns the button properly. + (propertize " " 'display (list 'space :align-to column) + 'face 'fixed-pitch) + name))) + '((0 . "") + (2 . "Process") + (16 . "Status") + (24 . "Buffer") + (40 . "TTY") + (54 . "Command")) + ""))) + + (defun process-menu-delete () + (interactive) + (let ((proc (get-text-property (point) 'process-list-process))) + (if (null (processp proc)) + (message "No process on this line.") + (if (y-or-n-p (format "Delete process %s? " (process-name proc))) + (progn + (delete-process proc) + (revert-buffer)) + (message "Aborted"))))) + + (defun list-processes-revert (&optional arg noconfirm) + "Update the list of processes. + This function is the `revert-buffer-function' for Process List + buffers. The arguments are ignored." + (interactive) + (list-processes process-menu--query-only (current-buffer))) + + (defun process-menu-info (&optional query-only) + "Return a list of plist of process information. + Each list element has the form (PROCESS NAME STATUS BUFFER TTY COMMAND)." + (let (proc-list buf type contact) + (dolist (p (process-list)) + (when (or (not query-only) + (process-query-on-exit-flag p)) + (setq buf (process-buffer p) + type (process-type p)) + (push + (list p ; The process itself + (process-name p) ; Name + (symbol-name (process-status p)) ; Status + (and (buffer-live-p buf) buf) ; Buffer + (process-tty-name p) ; TTY + (cond ; Command + ((eq type 'network) + (setq contact (process-contact p t)) + (format "(network %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))))) + ((eq type 'serial) + (setq contact (process-contact p t)) + (format "(serial port %s%s)" + (or (plist-get contact :port) "?") + (let ((speed (plist-get contact :speed))) + (if speed + (format " at %s b/s" speed) + "")))) + (t (mapconcat 'identity (process-command p) " ")))) + proc-list))) + proc-list)) + + (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) + (let ((info (process-menu-info query-only)) + (inhibit-read-only t) + (buf (or buffer (get-buffer-create "*Process List*"))) + line) + (with-current-buffer buf + (setq line (line-number-at-pos)) + (process-menu-mode) + (erase-buffer) + (set (make-local-variable 'process-menu--query-only) query-only) + (if info + (progn + (dolist (pinfo info) + (apply 'process-menu-insert pinfo)) + ;; Leave point at the same line as before. + (goto-char (point-min)) + (forward-line (1- line))) + (message "No processes exist")) + (set-buffer-modified-p nil)) + (display-buffer buf)) + nil) + + (defun process-menu-insert (process name status buffer tty command) + (let (str) + (insert (propertize " " 'process-list-process process)) + (setq str name) + (insert + (propertize + (if (> (length str) 15) + (concat (substring str 0 12) "...") + str) + 'help-echo name)) + (indent-to 16 1) + (insert status) + (indent-to 24 1) + (if (null buffer) + (insert "--") + (setq str (buffer-name buffer)) + (insert-text-button (if (> (length str) 15) + (concat (substring str 0 12) "...") + str) + 'face 'link + 'help-echo (concat "Visit buffer `" + (buffer-name buffer) + "'") + 'follow-link t + 'process-buffer buffer + 'action (lambda (button) + (display-buffer + (button-get button 'process-buffer))))) + (indent-to 40 1) + (insert tty) + (indent-to 54 1) + (insert command))) + (defvar universal-argument-map (let ((map (make-sparse-keymap))) (define-key map [t] 'universal-argument-other-key) === modified file 'src/process.c' *** src/process.c 2011-03-27 02:32:40 +0000 --- src/process.c 2011-04-04 00:12:35 +0000 *************** *** 1239,1486 **** return Qnil; } - - static Lisp_Object - list_processes_1 (Lisp_Object query_only) - { - register Lisp_Object tail; - Lisp_Object proc, minspace; - register struct Lisp_Process *p; - char tembuf[300]; - int w_proc, w_buffer, w_tty; - int exited = 0; - Lisp_Object i_status, i_buffer, i_tty, i_command; - - w_proc = 4; /* Proc */ - w_buffer = 6; /* Buffer */ - w_tty = 0; /* Omit if no ttys */ - - for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) - { - int i; - - proc = Fcdr (XCAR (tail)); - p = XPROCESS (proc); - if (NILP (p->type)) - continue; - if (!NILP (query_only) && p->kill_without_query) - continue; - if (STRINGP (p->name) - && ( i = SCHARS (p->name), (i > w_proc))) - w_proc = i; - if (!NILP (p->buffer)) - { - if (NILP (BVAR (XBUFFER (p->buffer), name))) - { - if (w_buffer < 8) - w_buffer = 8; /* (Killed) */ - } - else if ((i = SCHARS (BVAR (XBUFFER (p->buffer), name)), (i > w_buffer))) - w_buffer = i; - } - if (STRINGP (p->tty_name) - && (i = SCHARS (p->tty_name), (i > w_tty))) - w_tty = i; - } - - XSETFASTINT (i_status, w_proc + 1); - XSETFASTINT (i_buffer, XFASTINT (i_status) + 9); - if (w_tty) - { - XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1); - XSETFASTINT (i_command, XFASTINT (i_tty) + w_tty + 1); - } - else - { - i_tty = Qnil; - XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1); - } - - XSETFASTINT (minspace, 1); - - set_buffer_internal (XBUFFER (Vstandard_output)); - BVAR (current_buffer, undo_list) = Qt; - - BVAR (current_buffer, truncate_lines) = Qt; - - write_string ("Proc", -1); - Findent_to (i_status, minspace); write_string ("Status", -1); - Findent_to (i_buffer, minspace); write_string ("Buffer", -1); - if (!NILP (i_tty)) - { - Findent_to (i_tty, minspace); write_string ("Tty", -1); - } - Findent_to (i_command, minspace); write_string ("Command", -1); - write_string ("\n", -1); - - write_string ("----", -1); - Findent_to (i_status, minspace); write_string ("------", -1); - Findent_to (i_buffer, minspace); write_string ("------", -1); - if (!NILP (i_tty)) - { - Findent_to (i_tty, minspace); write_string ("---", -1); - } - Findent_to (i_command, minspace); write_string ("-------", -1); - write_string ("\n", -1); - - for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object symbol; - - proc = Fcdr (XCAR (tail)); - p = XPROCESS (proc); - if (NILP (p->type)) - continue; - if (!NILP (query_only) && p->kill_without_query) - continue; - - Finsert (1, &p->name); - Findent_to (i_status, minspace); - - if (p->raw_status_new) - update_status (p); - symbol = p->status; - if (CONSP (p->status)) - symbol = XCAR (p->status); - - if (EQ (symbol, Qsignal)) - { - Lisp_Object tem; - tem = Fcar (Fcdr (p->status)); - Fprinc (symbol, Qnil); - } - else if (NETCONN1_P (p) || SERIALCONN1_P (p)) - { - if (EQ (symbol, Qexit)) - write_string ("closed", -1); - else if (EQ (p->command, Qt)) - write_string ("stopped", -1); - else if (EQ (symbol, Qrun)) - write_string ("open", -1); - else - Fprinc (symbol, Qnil); - } - else if (SERIALCONN1_P (p)) - { - write_string ("running", -1); - } - else - Fprinc (symbol, Qnil); - - if (EQ (symbol, Qexit)) - { - Lisp_Object tem; - tem = Fcar (Fcdr (p->status)); - if (XFASTINT (tem)) - { - sprintf (tembuf, " %d", (int) XFASTINT (tem)); - write_string (tembuf, -1); - } - } - - if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) || EQ (symbol, Qclosed)) - exited++; - - Findent_to (i_buffer, minspace); - if (NILP (p->buffer)) - insert_string ("(none)"); - else if (NILP (BVAR (XBUFFER (p->buffer), name))) - insert_string ("(Killed)"); - else - Finsert (1, &BVAR (XBUFFER (p->buffer), name)); - - if (!NILP (i_tty)) - { - Findent_to (i_tty, minspace); - if (STRINGP (p->tty_name)) - Finsert (1, &p->tty_name); - } - - Findent_to (i_command, minspace); - - if (EQ (p->status, Qlisten)) - { - Lisp_Object port = Fplist_get (p->childp, QCservice); - if (INTEGERP (port)) - port = Fnumber_to_string (port); - if (NILP (port)) - port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil); - sprintf (tembuf, "(network %s server on %s)\n", - (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"), - (STRINGP (port) ? SSDATA (port) : "?")); - insert_string (tembuf); - } - else if (NETCONN1_P (p)) - { - /* For a local socket, there is no host name, - so display service instead. */ - Lisp_Object host = Fplist_get (p->childp, QChost); - if (!STRINGP (host)) - { - host = Fplist_get (p->childp, QCservice); - if (INTEGERP (host)) - host = Fnumber_to_string (host); - } - if (NILP (host)) - host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil); - sprintf (tembuf, "(network %s connection to %s)\n", - (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"), - (STRINGP (host) ? SSDATA (host) : "?")); - insert_string (tembuf); - } - else if (SERIALCONN1_P (p)) - { - Lisp_Object port = Fplist_get (p->childp, QCport); - Lisp_Object speed = Fplist_get (p->childp, QCspeed); - insert_string ("(serial port "); - if (STRINGP (port)) - insert_string (SSDATA (port)); - else - insert_string ("?"); - if (INTEGERP (speed)) - { - sprintf (tembuf, " at %ld b/s", (long) XINT (speed)); - insert_string (tembuf); - } - insert_string (")\n"); - } - else - { - Lisp_Object tem = p->command; - while (1) - { - Lisp_Object tem1 = Fcar (tem); - if (NILP (tem1)) - break; - Finsert (1, &tem1); - tem = Fcdr (tem); - if (NILP (tem)) - break; - insert_string (" "); - } - insert_string ("\n"); - } - } - if (exited) - { - status_notify (NULL); - redisplay_preserve_echo_area (13); - } - return Qnil; - } - - DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P", - doc: /* Display a list of all processes. - If optional argument QUERY-ONLY is non-nil, only processes with - the query-on-exit flag set will be listed. - Any process listed as exited or signaled is actually eliminated - after the listing is made. */) - (Lisp_Object query_only) - { - internal_with_output_to_temp_buffer ("*Process List*", - list_processes_1, query_only); - return Qnil; - } DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, doc: /* Return a list of all processes. */) --- 1239,1244 ---- *************** *** 7679,7685 **** defsubr (&Sprocess_contact); defsubr (&Sprocess_plist); defsubr (&Sset_process_plist); - defsubr (&Slist_processes); defsubr (&Sprocess_list); defsubr (&Sstart_process); defsubr (&Sserial_process_configure); --- 7437,7442 ----