From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Bob Rogers Newsgroups: gmane.emacs.devel Subject: Elisp implementation of list-processes Date: Tue, 30 Nov 2010 01:05:58 -0500 Message-ID: <19700.37958.1149.668766@rgr.rgrjr.com> References: <19697.21373.201776.909872@rgr.rgrjr.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: dough.gmane.org 1291200049 24766 80.91.229.12 (1 Dec 2010 10:40:49 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Wed, 1 Dec 2010 10:40:49 +0000 (UTC) To: Stefan Monnier , emacs-devel Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Dec 01 11:40:42 2010 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 1PNk76-0005jO-4U for ged-emacs-devel@m.gmane.org; Wed, 01 Dec 2010 11:40:41 +0100 Original-Received: from localhost ([127.0.0.1]:33067 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PNk75-00066b-AC for ged-emacs-devel@m.gmane.org; Wed, 01 Dec 2010 05:40:39 -0500 Original-Received: from [140.186.70.92] (port=38476 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PNfcu-0008PZ-4R for emacs-devel@gnu.org; Wed, 01 Dec 2010 00:53:37 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PNJLz-0000x8-N1 for emacs-devel@gnu.org; Tue, 30 Nov 2010 01:06:17 -0500 Original-Received: from rgrjr.com ([216.146.47.5]:56834) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PNJLz-0000u5-IL for emacs-devel@gnu.org; Tue, 30 Nov 2010 01:06:15 -0500 Original-Received: from rgrjr.dyndns.org (c-66-30-196-77.hsd1.ma.comcast.net [66.30.196.77]) by rgrjr.com (Postfix on CentOS) with ESMTP id CE1E11601AB for ; Tue, 30 Nov 2010 06:06:13 +0000 (UTC) Original-Received: (qmail 12278 invoked by uid 89); 30 Nov 2010 06:06:13 -0000 Original-Received: from unknown (HELO rgr.rgrjr.com) (192.168.57.1) by home with SMTP; 30 Nov 2010 06:06:13 -0000 Original-Received: by rgr.rgrjr.com (Postfix, from userid 500) id 8B364A4E90; Tue, 30 Nov 2010 01:05:58 -0500 (EST) In-Reply-To: X-Mailer: VM 7.19 under Emacs 24.0.50.2 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) 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:133266 Archived-At: From: Stefan Monnier Date: Sun, 28 Nov 2010 13:49:36 -0500 . . . BTW, rather than add a hook to this piece of C code, I'd much rather move this piece of code to Elisp first. There is no good reason for it to be written in C. If it can't currently be written in Elisp because of some missing Elisp primitives, then they should be added. Stefan A nearly complete Elisp implementation of Flist_processes is included below; feedback welcome. It should produce the identical output (except for using buttons for buffer names), though I haven't tested it on the more exotic kinds of processes. The only thing I couldn't do was the following snippet from the very end: if (exited) { status_notify (NULL); redisplay_preserve_echo_area (13); } status_notify is a static function in process.c, used to clean up when we find exited processes. It is unclear to me whether redisplay_preserve_echo_area is really necessary. In any case, a small DEFUN would seem to be in order. Not sure what to call it, though; "status_notify" is not very informative. Perhaps "process-clean-up"? The only other question is: Where should it go? It is called from save-buffers-kill-emacs in files.el (the only other use is in lisp/eshell/esh-proc.el), but files.el is already pretty crowded. On the other hand, autoloading it for something so basic might be problematic. Suggestions? -- Bob Rogers http://www.rgrjr.com/ ------------------------------------------------------------------------ ;;;; Elisp implementation of list-processes. (defun list-proc-insert-line (minspace underline-p &rest labels-and-indents) (let ((tail labels-and-indents)) (while tail (let ((item (pop tail))) (cond ((null item) ;; Ignore the next. (pop tail)) ((integerp item) (indent-to item minspace)) (underline-p (insert (make-string (length item) ?-))) ((bufferp item) (let ((name (buffer-name item))) (if (not name) (insert "(Killed)") (insert-button (buffer-name item) 'action 'list-proc-button-select-buffer 'help-echo "mouse-2, RET: Select this buffer" 'buffer-name (buffer-name item))))) (t (insert item)))))) (insert "\n")) (defun list-proc-button-select-buffer (button) ;; Select the buffer named by the buffer-name property of the button. (let* ((buffer-name (button-get button 'buffer-name)) (buffer (and buffer-name (get-buffer buffer-name)))) (when buffer (switch-to-buffer buffer)))) (defun list-proc-make-command (proc) ;; Return a string that describes the process-command of PROC. This is just ;; the list of command words for a normal subprocess, and a description for ;; network and serial connections. (let ((status (process-status proc)) (proc-type (process-type proc)) (command (process-command proc))) (cond ((eq status 'listen) ;; It's a listening server socket. (let ((port (plist-get (process-plist proc) :service)) (type (if (process-datagram-address proc) "datagram" "stream"))) (cond ((integerp port) (setq port (number-to-string port))) ((null port) (setq port (format-network-address (plist-get (process-plist proc) :local))))) (concat "(network " type " server on " port ")"))) ((eq proc-type 'network) (let ((host (plist-get (process-plist proc) :host)) (type (if (process-datagram-address proc) "datagram" "stream"))) (unless (stringp host) (setq host (plist-get (process-plist proc) :service)) (when (integerp host) (setq host (format "%d" host)))) (when (null host) (setq host (format-network-address (plist-get (process-plist proc) :remote)))) (concat "(network " type " connection to " (if (stringp host) host "?") ")"))) ((eq proc-type 'serial) (let ((port (plist-get (process-plist proc) :port)) (speed (plist-get (process-plist proc) :speed))) (concat "(serial port " (if (stringp port) port "?") (if (integerp speed) (format " at %d b/s" speed) "") ")"))) (t (mapconcat 'identity command " "))))) (defun list-proc-make-status (proc) ;; Return a string describing the PROC's process-status. (let ((status (process-status proc))) (when (consp status) (setq status (car status))) (let ((result (cond ((eq status 'signal) (symbol-name status)) ((member (process-type proc) '(network serial)) (cond ((eq status 'exit) "closed") ((eq (process-command proc) t) "stopped") ((eq status 'run) "open") (t (symbol-name status)))) (t (symbol-name status))))) (if (eq status 'exit) (let ((code (cadr (process-status proc)))) (format "%s %d" result code)) result)))) (defun el-list-processes (&optional query-only) "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." (interactive) (with-current-buffer (get-buffer-create "*Process List*") (let ((w-proc 4) (w-buffer 6) (w-tty 0) (filtered-processes nil)) ;; Compute field widths. (dolist (proc (process-list)) (let ((type (process-type proc)) (name (process-name proc)) (tty-name (process-tty-name proc)) (buffer (process-buffer proc))) (when (and type (or (not query-only) (process-query-on-exit-flag proc))) (push proc filtered-processes) (if (and name (> (length name) w-proc)) (setq w-proc (length name))) (if buffer (let* ((buf-name (buffer-name buffer)) (len (if buf-name (length buf-name) ;; "(Killed)" 8))) (if (> len w-buffer) (setq w-buffer len)))) (if (and tty-name (> (length tty-name) w-tty)) (setq w-tty (length tty-name)))))) ;; Print headings. (let* ((i-status (+ w-proc 1)) (i-buffer (+ i-status 9)) (i-tty nil) (i-command (+ i-buffer w-buffer 1)) (minspace 1) (buffer-read-only nil) (buffer-undo-list t)) (when (> w-tty 0) (setq i-tty i-command i-command (+ i-tty w-tty 1))) (setq truncate-lines t) (erase-buffer) (dolist (underline-p '(nil t)) (list-proc-insert-line minspace underline-p "Proc" i-status "Status" i-buffer "Buffer" i-tty "Tty" i-command "Command")) ;; Generate content. (dolist (proc filtered-processes) (list-proc-insert-line minspace nil (process-name proc) i-status (list-proc-make-status proc) i-buffer (or (process-buffer proc) "(none)") i-tty (or (process-tty-name proc) "") i-command (list-proc-make-command proc))) ;; Done. (goto-char (point-min)) (set-buffer-modified-p nil) (display-buffer (current-buffer))))))