list-processes reimplementation, and list/menu buffers

list-processes reimplementation, and list/menu buffers

[Chong Yidong]

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))))
  
  \f
+ (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)))
+ \f
  (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;
  }
- \f
- 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 ----

Re: list-processes reimplementation, and list/menu buffers

[Leo]

Hello Yidong,

On 2011-04-04 08:48 +0800, Chong Yidong wrote:
> 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.
[...]

Thanks for the work. I will try it out later today.

It seems list-processes no longer cleans up dead processes. How about
adding something like:

  (mapc (lambda (p)
        (when (memq (process-status p) '(exit signal closed))
          (delete-process p)))
      (process-list))

towards the end of list-processes in the patch?¹

Also, some people ask to be able to visit process buffers. Maybe we
should also bind RET to visit the process buffer under point?

Footnotes: 
¹  http://article.gmane.org/gmane.emacs.devel/136367

Leo

Re: list-processes reimplementation, and list/menu buffers

[Leo]

On 2011-04-04 09:06 +0800, Leo wrote:
> Thanks for the work. I will try it out later today.

I just briefly tried the patch. Looks very nice.

BTW, there is this feature request (from Kevin and CC'd) when I posted
my implementation to emacs-help:
http://article.gmane.org/gmane.emacs.help/77767.

Regards,
Leo

Re: list-processes reimplementation, and list/menu buffers

[Tom Tromey]

>>>>> "Chong" == Chong Yidong <cyd@stupidchicken.com> writes:

Chong> However, it would be cleaner to make a new `list-menu-mode' major mode,
Chong> usable for general "list of stuff" buffers.  Then both the list-packages
Chong> and list-processes can derive from that major mode.  With a bit more
Chong> work, list-buffers could use it too.  I will investigate this approach.

FWIW, afterwards I wished I had written list-packages based on EWOC.
Maybe that would be a suitable starting point.

Tom

Re: list-processes reimplementation, and list/menu buffers

[Chong Yidong]

Chong Yidong <cyd@stupidchicken.com> writes:

> 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.

The refactoring turns out to be quite straightforward---see below (a few
more bells and whistles remain to be added).  By inheriting from this
mode, the corresponding Lisp implementation of list-processes comes to
60-70 lines, and can fit comfortably in simple.el.

One issue is what to call the generic major mode.  I chose menu-buffer
because the inheriting modes would be called *-menu-mode (package-menu,
process-menu...), but I'm not crazy about the name.

I looked into using ewoc, but it seemed to provide little benefit,
because there's no complex insertion or deletion of data entries being
performed; for both the package-menu and process-menu, entries are just
regenerated from scratch each time anyway.



;;; menu-buffer.el --- major mode for displaying generic lists.

;; Copyright (C) 2011 Free Software Foundation, Inc.

;; Keywords: extensions, lisp

;; 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, 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(defvar menu-buffer-format nil
  "The format of the current menu buffer.
This should be a list, each element having the form
 (TAG WIDTH SORT), where:

 TAG is a string describing the column.

 WIDTH is the width to reserve for the column.
  For the final element, its numerical value is ignored.

 SORT specifies how to sort the entries by this column.
  If nil, the values in this column cannot be used for sorting.
  Otherwise, this should be a predicate function suitable for
  `sort'.  The arguments to this function are the entries
  returned by `menu-buffer-generate-list-function'.")
(make-variable-buffer-local 'menu-buffer-format)

(defvar menu-buffer-generate-list-function nil
  "Function producing the entries listed in the current buffer.
This is called with no arguments.  It should return a list of
elements of the form (ID . DESC-LIST), where:

ID is either nil, or a Lisp object uniquely identifying this
entry.  The latter is used to keep the cursor on the \"same\"
entry when re-sorting the menu; comparison is done with `equal'.

DESC-LIST is a list of column descriptors, one for each column
specified in `menu-buffer-format'.  Each descriptor should be a
string, which is printed as-is, or a list (LABEL . PROPS), which
means to use `insert-text-button' to insert a text button with
label LABEL and button properties PROPS.")
(make-variable-buffer-local 'menu-buffer-generate-list-function)

;; Internal variables and functions.

(defvar menu-buffer-sort-key nil
  "Sort key for the current menu buffer.
If nil, no additional sorting is performed on the return value of
 `menu-buffer-generate-list-function'.
Otherwise, this should be a string matching one of the TAG values
 in `menu-buffer-format'; this means to use the sorting method
 defined in that `menu-buffer-format' entry.")

(make-variable-buffer-local 'menu-buffer-sort-key)

(defvar menu-buffer-mode-map
  (let ((map (copy-keymap special-mode-map)))
    (set-keymap-parent map button-buffer-map)
    (define-key map "n" 'next-line)
    (define-key map "p" 'previous-line)
    (define-key map [follow-link] 'mouse-face)
    (define-key map [mouse-2] 'mouse-select-window)
    map)
  "Local keymap for `menu-buffer-mode' buffers.")

(defvar menu-buffer-sort-button-map
  (let ((map (make-sparse-keymap)))
    (define-key map [header-line mouse-1] 'menu-buffer-sort-by-column)
    (define-key map [header-line mouse-2] 'menu-buffer-sort-by-column)
    (define-key map [follow-link] 'mouse-face)
    map)
  "Local keymap for `menu-buffer-mode' sort buttons.")

;;;###autoload
(define-derived-mode menu-buffer-mode special-mode "Menu Buffer"
  "Generic major mode for browsing a list of items.
This mode is not intended to be directly used.  Instead, other
major modes should build on it using `define-derived-mode'.

Inheriting modes should:
 - Possibly define a `before-revert-hook'.
 - Set `menu-buffer-format'.
 - Set `menu-buffer-generate-list-function'.
 - Define a command that calls `menu-buffer-initialize'."
  (setq truncate-lines t)
  (setq buffer-read-only t)
  (set (make-local-variable 'revert-buffer-function) 'menu-buffer-revert))

(put 'menu-buffer-mode 'mode-class 'special)

(defun menu-buffer-initialize ()
  "Initialize the menu buffer from `menu-buffer-format'."
  ;; Set up the contents of the header line.
  (let ((x 1)
	(cols (list (propertize " " 'display `(space :align-to 1)))))
    (dolist (col menu-buffer-format)
      (setq x (+ x 1 (nth 1 col)))
      (push (if (nth 2 col)
		(propertize (car col)
			    'column-name (car col)
			    'help-echo "Click to sort by column"
			    'mouse-face 'highlight
			    'keymap menu-buffer-sort-button-map)
	      (car col))
	    cols)
      (push (propertize " "
			'display (list 'space :align-to x)
			'face 'fixed-pitch)
	    cols))
    (setq header-line-format (mapconcat 'identity (nreverse cols) "")))
  ;; Populate the buffer.
  (menu-buffer-generate-list))

(defun menu-buffer-revert (&rest ignored)
  "The `revert-buffer-function' for `menu-buffer-mode'.
This just calls `menu-buffer-generate-list'."
  (interactive)
  (unless (derived-mode-p 'menu-buffer-mode)
    (error "The current buffer is not a menu buffer"))
  (menu-buffer-generate-list t))

(defun menu-buffer-generate-list (&optional remember-pos)
  "Populate the current `menu-buffer-mode' buffer.
Optional argument REMEMBER-POS, if non-nil, means to move point
to the \"same\" entry afterwards (as determined by the ID element
in `menu-buffer-generate-list-function')."
  (let ((inhibit-read-only t)
	entry-id saved-pt saved-col info-list)
    (and remember-pos
	 (setq entry-id
	       (get-text-property (line-beginning-position)
				  'menu-buffer-id))
	 (setq saved-col (current-column)))
    (erase-buffer)
    (setq info-list (funcall menu-buffer-generate-list-function))
    ;; Sort the buffers, if necessary.
    (let (elt sort-fun)
      (and menu-buffer-sort-key
	   (setq elt (assoc menu-buffer-sort-key menu-buffer-format))
	   (functionp (setq sort-fun (nth 2 elt)))
	   (sort info-list sort-fun)))
    ;; Print the resulting list.
    (dolist (elt info-list)
      (and entry-id
	   (equal entry-id (car elt))
	   (setq saved-pt (point)))
      (menu-buffer-print-entry elt))
    (set-buffer-modified-p nil)
    ;; If REMEMBER-POS was specified, move to the "old" location.
    (if saved-pt
	(progn (goto-char saved-pt)
	       (forward-char saved-col))
      (goto-char (point-min)))))

(defun menu-buffer-print-entry (entry)
  "Insert the menu entry for ENTRY at point.
ENTRY should have the form (ID . DESC-LIST), like in the return
value of `menu-buffer-generate-list-function'."
  (let ((id   (car entry))
	(cols (cdr entry))
	(tail menu-buffer-format)
	(x 1)
	col-format)
    (insert (propertize " " 'menu-buffer-id id))
    (while tail
      (setq col-format (car tail))
      (let* ((col-desc (pop cols))
	     (width (nth 1 col-format))
	     (label (if (stringp col-desc)
			col-desc
		      (car col-desc)))
	     (help-echo (concat (car col-format) ": " label)))
	;; Truncate labels if necessary.
	(and (> width 6)
	     (> (length label) width)
	     (setq label (concat (substring col-desc 0 (- width 3))
				 "...")))
	(if (stringp col-desc)
	    (insert (propertize label 'help-echo help-echo))
	  (apply 'insert-text-button label (cdr col-desc)))
	(setq x (+ x 1 width)))
      (setq tail (cdr tail))
      (if tail (indent-to x 1))))
  (insert ?\n))

(defun menu-buffer-sort-by-column (&optional e)
  "Sort menu buffer entries by the column of the mouse click E."
  (interactive "e")
  (let* ((pos (event-start e))
	 (obj (posn-object pos))
	 (tag (if obj
		  (get-text-property (cdr obj) 'column-name (car obj))
		(get-text-property (posn-point pos) 'column-name)))
	 (buf (window-buffer (posn-window (event-start e)))))
    (with-current-buffer buf
      (when (derived-mode-p 'menu-buffer-mode)
	(setq menu-buffer-sort-key tag)
	(menu-buffer-generate-list t)))))

(provide 'menu-buffer)

;;; menu-buffer.el ends here

Re: list-processes reimplementation, and list/menu buffers

[Stefan Monnier]

> One issue is what to call the generic major mode.  I chose menu-buffer
> because the inheriting modes would be called *-menu-mode (package-menu,
> process-menu...), but I'm not crazy about the name.

I think an important feature of this parent mode is that it handles
tabulated data (as opposed to things like completion-list-mode), so that
might give us a clue for what name to give it.
Maybe tabulated-list-mode?

BTW: I think mpc.el's MPC-Songs buffer could use such a parent mode as well.

> I looked into using ewoc, but it seemed to provide little benefit,
> because there's no complex insertion or deletion of data entries being
> performed; for both the package-menu and process-menu, entries are just
> regenerated from scratch each time anyway.

Agreed.  But it would be desirable to use ewoc on top of this new parent
mode, for modes such as VC-Dir.


        Stefan

Re: list-processes reimplementation, and list/menu buffers

[Chong Yidong]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

> I think an important feature of this parent mode is that it handles
> tabulated data (as opposed to things like completion-list-mode), so
> that might give us a clue for what name to give it.  Maybe
> tabulated-list-mode?

It's a bit wordy, but I can't come up with anything better, so OK.

>> I looked into using ewoc, but it seemed to provide little benefit,
>> because there's no complex insertion or deletion of data entries being
>> performed; for both the package-menu and process-menu, entries are just
>> regenerated from scratch each time anyway.
>
> Agreed.  But it would be desirable to use ewoc on top of this new parent
> mode, for modes such as VC-Dir.

Yes, good point.  I think this should be easy to arrange.

Re: list-processes reimplementation, and list/menu buffers

[Chong Yidong]

Chong Yidong <cyd@stupidchicken.com> writes:

>> I think an important feature of this parent mode is that it handles
>> tabulated data (as opposed to things like completion-list-mode), so
>> that might give us a clue for what name to give it.  Maybe
>> tabulated-list-mode?
>
> It's a bit wordy, but I can't come up with anything better, so OK.

I've committed tabulated-list.el to the trunk.