From: lystad@m2.dseg.ti.com (Garr Lystad)
Subject: Re: Mouse enhancements for buffer-menu mode
Organization: TI DSEG, Spring Creek, Plano, Tx.
Reply-To: Garr Lystad <lystad@m2.dseg.ti.com>
Date: Thu, 27 Aug 1992 15:04:46 GMT

In article <1992Aug26.165853.22947@kocrsv01.delcoelect.com> c23mts@kocrsv01.delcoelect.com (Mike Scheidler) writes:


>   Here are a couple of mouse-based functions I use with buffer menu mode.
>   They're not elegant or complicated, but they make my life a little easier.
>   ....

I too have made some functions for buffer-menu-mode.  Mine are not
elegant or complicated either, but they offer a couple of other
options.
 
The commands and key settings are as follows:
(local-set-key '(shift button1) 'mouse-select-buffer-1-window)
(local-set-key '(shift button2) 'mouse-select-buffer-this-window)
(local-set-key '(shift button3) 'mouse-select-buffer-other-window) )))
(local-set-key '(button2) 'mouse-select-buffer-this-window)
(local-set-key '(button3) 'mouse-select-buffer-other-window)
(define-key global-map "\C-c\C-b" 'list-buffers-1-window)

I don't use multiple screens, so I don't have something for that, as
Mike does.  

Since I often have a lot of buffers, I have added a command to put the
buffer list in one window, the last command above.

I have also altered list-buffers, as commented in the code below, so
that an argument of 2 will list only modified file buffers (handy in
the middle of various tags operations) and an argument of 3 will list
only dired mode buffers.  An argument of anything else, as previously,
will list all file buffers only.

In case you are wondering why the macro is written without backquotes,
etc., it was for practice.  I remember finding a bug in the backquote
package a year or more ago with Emacs 18.58 and was thinking about
repairs.  Then I got to use a Lisp machine again and now I've
forgotten what the bug was.  Does anyone know of anything wrong with
backquotes or anything that has been fixed since that Emacs?


;;;; modifications to list buffers, and eval-in-buffer macro used there

;; Taken from the file sun-mouse.el
(defmacro  (buffer &rest forms)
  "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer."
  ;; When you don't need the complete window context of eval-in-window
  (nconc (list 'let)
	 (list '((start-buffer (current-buffer))))
	 (list (nconc (list 'unwind-protect)
		      (list (nconc (list 'progn)
				   (list (list 'set-buffer buffer))
				   forms))
		      (list '(set-buffer start-buffer)) ))) )

(put 'eval-in-buffer 'lisp-indent-hook 1)

(defun goto-event-char (event)
  "Arglist: (event). Move point to the mouse-click."
  (let ((event-buffer (window-buffer (event-window event))))
    (if (eql (current-buffer) event-buffer)  
	(switch-to-buffer event-buffer)
      (switch-to-buffer-other-window event-buffer) )
    (if (event-point event) (goto-char (event-point event))) ))

(defun mouse-select-buffer-1-window (event)
  "Select this line's buffer, alone, in full screen."
  (interactive "e")
  (goto-event-char event)
  (Buffer-menu-1-window) )

(defun mouse-select-buffer-other-window (event)
  "Select this line's buffer, alone, in other window."
  (interactive "e")
  (goto-event-char event)
  (Buffer-menu-other-window) )

(defun mouse-select-buffer-this-window (event)
  "Select this line's buffer, alone, in this window."
  (interactive "e")
  (goto-event-char event)
  (Buffer-menu-this-window) )

;;; for buffer-menu-mode

(defun install-buffer-list-map ()
  (let ((buffer (get-buffer "*Buffer List*")))
    (eval-in-buffer buffer
      (local-set-key '(shift button1) 'mouse-select-buffer-1-window)
      (local-set-key '(shift button2) 'mouse-select-buffer-this-window)
      (local-set-key '(button2) 'mouse-select-buffer-this-window)
      (local-set-key '(button3) 'mouse-select-buffer-other-window)
      (local-set-key '(shift button3) 'mouse-select-buffer-other-window) )))


(install-buffer-list-map)
 
(defun list-buffers-1-window (files)
  (interactive "P")
  (list-buffers files)
  (switch-to-buffer (get-buffer "*Buffer List*"))
  (delete-other-windows)
  )

(define-key global-map "\C-c\C-b" 'list-buffers-1-window)

(defun list-buffers (&optional files-only)
  "Display a list of names of existing buffers.
Inserts it in buffer *Buffer List* and displays that.
Note that buffers with names starting with spaces are omitted.
Non-null optional arg FILES-ONLY means mention only file buffers.
  If FILES-ONLY has the special value 2, then only modified file buffers are listed.
  If FILES-ONLY has the special value 3, then only dired buffers are listed.

The M column contains a * for buffers that are modified.
The R column contains a % for buffers that are read-only."
  (interactive "P")
  (let ((current (current-buffer))
	(col1 19)
	output)
    (save-excursion
      (with-output-to-temp-buffer "*Buffer List*"
        (let ((buffers (buffer-list)))
          (setq output standard-output)
          (set-buffer output)
          (Buffer-menu-mode)
          (setq buffer-read-only nil)
          (buffer-disable-undo output)
          (insert list-buffers-header-line)
          (while buffers
            (let* ((buffer (car buffers))
                   (name (buffer-name buffer))
                   (file (buffer-file-name buffer)))
              (setq buffers (cdr buffers))
              (cond ((null name)) ;deleted buffer
                    ((and (/= 0 (length name));don't mention if starts with " "
                          (= (aref name 0) ?\ )))
                    ((and files-only (null file)
			  (not (eql files-only 3))))                            ;; gsl 8-20-92
		    ((and (eql files-only 2) (not (buffer-modified-p buffer)))) ;; gsl 8-20-92
		    ((and (eql files-only 3)                                    ;; gsl 8-20-92
			  (not (eql 'dired-mode                                 ;; gsl 8-20-92
				    (eval-in-buffer buffer major-mode))) ))     ;; gsl 8-20-92
                    (t
                     (set-buffer buffer)
                     (let ((ro buffer-read-only)
                           (id list-buffers-identification))
                       (set-buffer output)
                       (insert (if (eq buffer current)
                                   (progn (setq current (point)) ?\.)
                                   ?\ ))
		       (insert (if (buffer-modified-p buffer)
                                   ?\* 
				   ?\ ))
		       (insert (if ro
                                   ?\%
                                   ?\ ))
                       (if (string-match "[\n\"\\ \t]" name)
                           (let ((print-escape-newlines t))
                             (prin1 name output))
                           (insert ?\  name))
                       (indent-to col1 1)
                       (cond ((stringp id)
                              (insert id))
                             (id
                              (set-buffer buffer)
                              (condition-case e
                                  (funcall id output)
                                (error
                                 (princ "***" output) (prin1 e output)))
                              (set-buffer output)
                              (goto-char (point-max)))))
                     (insert ?\n)))))
          (setq buffer-read-only t))))
    (if (not (bufferp current))
	(save-excursion
	  (set-buffer output)
	  (goto-char current)))))

;;------------------------------------- end of file

  --  Garr
Newsgroups: alt.lucid-emacs.help