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: Re: list-processes reimplementation, and list/menu buffers Date: Tue, 05 Apr 2011 12:09:46 -0400 Message-ID: <87y63o65o5.fsf@stupidchicken.com> References: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1302019851 15677 80.91.229.12 (5 Apr 2011 16:10:51 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Tue, 5 Apr 2011 16:10:51 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Apr 05 18:10:47 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 1Q78pw-0000rJ-OB for ged-emacs-devel@m.gmane.org; Tue, 05 Apr 2011 18:10:46 +0200 Original-Received: from localhost ([127.0.0.1]:56677 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Q78pp-0003Db-Ll for ged-emacs-devel@m.gmane.org; Tue, 05 Apr 2011 12:10:29 -0400 Original-Received: from [140.186.70.92] (port=33541 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Q78pW-00030t-6n for emacs-devel@gnu.org; Tue, 05 Apr 2011 12:10:15 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Q78pD-0007LY-8N for emacs-devel@gnu.org; Tue, 05 Apr 2011 12:09:52 -0400 Original-Received: from vm-emlprdomr-06.its.yale.edu ([130.132.50.147]:53020) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Q78pD-0007LH-5j for emacs-devel@gnu.org; Tue, 05 Apr 2011 12:09:51 -0400 Original-Received: from furball (dhcp128036014187.central.yale.edu [128.36.14.187]) (authenticated bits=0) by vm-emlprdomr-06.its.yale.edu (8.14.4/8.14.4) with ESMTP id p35G9lIb016886 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=NOT) for ; Tue, 5 Apr 2011 12:09:47 -0400 Original-Received: by furball (Postfix, from userid 1000) id 67135160401; Tue, 5 Apr 2011 12:09:46 -0400 (EDT) In-Reply-To: (Chong Yidong's message of "Sun, 03 Apr 2011 20:48:56 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (gnu/linux) X-Scanned-By: MIMEDefang 2.71 on 130.132.50.147 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 130.132.50.147 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:138181 Archived-At: Chong Yidong 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