From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Leo Newsgroups: gmane.emacs.devel Subject: Re: Why is list-processes implemented in C? Date: Mon, 29 Nov 2010 13:59:23 +0000 Message-ID: References: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1291039197 8554 80.91.229.12 (29 Nov 2010 13:59:57 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Mon, 29 Nov 2010 13:59:57 +0000 (UTC) Cc: Stefan Monnier , emacs-devel@gnu.org To: Andreas Schwab Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Nov 29 14:59:51 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 1PN4Gf-0004TI-Al for ged-emacs-devel@m.gmane.org; Mon, 29 Nov 2010 14:59:46 +0100 Original-Received: from localhost ([127.0.0.1]:51710 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PN4Ge-0002PA-AS for ged-emacs-devel@m.gmane.org; Mon, 29 Nov 2010 08:59:44 -0500 Original-Received: from [140.186.70.92] (port=46617 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PN4GU-0002EQ-OB for emacs-devel@gnu.org; Mon, 29 Nov 2010 08:59:39 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PN4GN-0007S9-Lt for emacs-devel@gnu.org; Mon, 29 Nov 2010 08:59:34 -0500 Original-Received: from ppsw-41.csi.cam.ac.uk ([131.111.8.141]:53710) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PN4GN-0007Qp-8I for emacs-devel@gnu.org; Mon, 29 Nov 2010 08:59:27 -0500 X-Cam-AntiVirus: no malware found X-Cam-SpamDetails: not scanned X-Cam-ScannerInfo: http://www.cam.ac.uk/cs/email/scanner/ Original-Received: from cpc1-cmbg13-0-0-cust596.5-4.cable.virginmedia.com ([86.9.122.85]:65399 helo=Victoria.local) by ppsw-41.csi.cam.ac.uk (smtp.hermes.cam.ac.uk [131.111.8.156]:587) with esmtpsa (PLAIN:sl392) (TLSv1:DHE-RSA-AES128-SHA:128) id 1PN4GK-0008Ud-S1 (Exim 4.72) (return-path ); Mon, 29 Nov 2010 13:59:25 +0000 In-Reply-To: (Andreas Schwab's message of "Mon, 29 Nov 2010 13:14:36 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (Mac OS X 10.6.5) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) 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:133229 Archived-At: --=-=-= On 2010-11-29 12:14 +0000, Andreas Schwab wrote: > What about the tty column? > > Andreas. Thanks. The doc-string of list-processes says "Any process listed as exited or signaled is actually eliminated after the listing is made." How to achieve that in elisp? Attempt 2: --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=emacs-process.el Content-Transfer-Encoding: quoted-printable Content-Description: emacs-process.el ;;; emacs-process.el --- list processes by Emacs ;; Author: Leo ;; Keywords: processes, tools ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; Code: (eval-when-compile (require 'cl)) (defvar emacs-process-mode-map (let ((m (make-sparse-keymap))) (define-key m "\C-k" 'emacs-process-delete) (define-key m "n" 'next-line) (define-key m "p" 'previous-line) (define-key m "g" 'emacs-process-list) (define-key m "q" 'quit-window) m)) (defun emacs-process-delete (name) (interactive (list (let ((def (get-text-property (point) 'process-name))) (completing-read (if def (format "Delete process (default %s): " def) "Delete process: ") (mapcar 'process-name (process-list)) nil t nil nil def)))) (delete-process name) (emacs-process-list)) (define-derived-mode emacs-process-mode fundamental-mode "Emacs Processes" (setq buffer-read-only t) (easy-menu-define emacs-process-menu emacs-process-mode-map "Emacs Process Menu" `("Processes" ["Next line" next-line] ["Previous line" previous-line] ["Update" emacs-process-list :help "Update process list"] ("Delete" ,@(mapcar (lambda (p) (vector (process-name p) (list 'emacs-process-delete p) :help (format "Delete process %s" p))) (process-list)))))) (defun emacs-process-info (&optional query-only) "Return a list of (NAMES STATUSES BUFFERS TTYS COMMANDS)." (let (processes statuses buffers ttys commands) (mapc (lambda (p) (when (or (not query-only) (and query-only (process-query-on-exit-flag p))) (push (process-name p) processes) (push (symbol-name (process-status p)) statuses) (push (let ((buf (process-buffer p))) (cond ((null buf) "(none)") ((not (buffer-live-p buf)) "(Killed)") (t (buffer-name buf)))) buffers) (push (process-tty-name p) ttys) (push (case (process-type p) (network (destructuring-bind (&key server type service host &allow-other-keys) (process-contact p t) (format "(network %s %s)" (if type "datagram" "stream") (if server (format "server on %s" service) (format "connection to %s" host)= )))) (serial (destructuring-bind (&key port speed &allow-other-keys) (process-contact p t) (format "(serial port %s%s)" (or port "?") (if speed (format " at %s b/s" speed) "")))) (otherwise (mapconcat 'identity (process-command p) "= "))) commands))) (process-list)) (mapcar 'nreverse (list processes statuses buffers ttys commands)))) ;;;###autoload (defalias 'list-processes 'emacs-process-list) ;;;###autoload (defun emacs-process-list (&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) (let ((buf (get-buffer-create "*Process List2*")) (inhibit-read-only t)) (with-current-buffer buf (erase-buffer) (destructuring-bind (names statuses buffers ttys commands &aux col1 col2 col3 col4 ttyp) (emacs-process-info query-only) (setq ttyp (remove nil ttys)) (setq names (append '("Proc" "----") names) statuses (append '("Status" "------") statuses) buffers (append '("Buffer" "------") buffers) ttys (append '("Tty" "---") ttys) commands (append '("Command" "-------") commands)) ;; compute indentations (setq col1 (1+ (apply 'max (mapcar 'length names))) col2 (+ col1 (1+ (apply 'max (mapcar 'length statuses)))) col3 (+ col2 (1+ (apply 'max (mapcar 'length buffers)))) col4 (if ttyp (+ col3 (1+ (apply 'max (mapcar 'length ttys)))) col3)) (loop for name in names for status in statuses for buffer in buffers for tty in ttys for command in commands for index from 0 do (insert name) (indent-to col1) (insert status) (indent-to col2) (insert buffer) (indent-to col3) (when ttyp (and tty (insert tty)) (indent-to col4)) (insert command) (when (> index 1) (put-text-property (line-beginning-position) (line-end-position) 'process-name name)) (insert "\n"))) (set-buffer-modified-p nil) (goto-char (point-min)) (emacs-process-mode)) (display-buffer buf))) (provide 'emacs-process) --=-=-= Leo --=-=-=--