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

[Chong Yidong]

Chong Yidong <address@hidden> 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