;;; msb.el --- customizable buffer-selection with multiple menus
-;; Copyright (C) 1993-1995, 1997-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1997-2016 Free Software Foundation, Inc.
;; Author: Lars Lindberg <lars.lindberg@home.se>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 8 Oct 1993
;; Lindberg's last update version: 3.34
;; Keywords: mouse buffer menu
;; hacked on by Dave Love.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
-;;;
-;;; Some example constants to be used for `msb-menu-cond'. See that
-;;; variable for more information. Please note that if the condition
-;;; returns `multi', then the buffer can appear in several menus.
-;;;
+;;
+;; Some example constants to be used for `msb-menu-cond'. See that
+;; variable for more information. Please note that if the condition
+;; returns `multi', then the buffer can appear in several menus.
+;;
(defconst msb--few-menus
'(((and (boundp 'server-buffer-clients)
server-buffer-clients
:group 'msb)
(defvar msb-files-by-directory-sort-key 0
- "*The sort key for files sorted by directory.")
+ "The sort key for files sorted by directory.")
(defcustom msb-max-menu-items 15
"The maximum number of items in a menu.
:group 'msb)
(defvar msb-horizontal-shift-function (lambda () 0)
- "*Function that specifies how many pixels to shift the top menu leftwards.")
+ "Function that specifies how many pixels to shift the top menu leftwards.")
(defcustom msb-display-invisible-buffers-p nil
"Show invisible buffers or not.
:group 'msb)
(defvar msb-item-handling-function 'msb-item-handler
- "*The appearance of a buffer menu.
+ "The appearance of a buffer menu.
The default function to call for handling the appearance of a menu
item. It should take two arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
;;;
;;; Some example function to be used for `msb-item-handling-function'.
;;;
-(defun msb-item-handler (buffer &optional maxbuf)
+(defun msb-item-handler (_buffer &optional _maxbuf)
"Create one string item, concerning BUFFER, for the buffer menu.
The item looks like:
*% <buffer-name>
(error "Unknown type of `dired-directory' in buffer %s"
(buffer-name)))))
-(defun msb-dired-item-handler (buffer &optional maxbuf)
+(defun msb-dired-item-handler (_buffer &optional _maxbuf)
"Create one string item, concerning a dired BUFFER, for the buffer menu.
The item looks like:
*% <buffer-name>
(defun msb--create-function-info (menu-cond-elt)
"Create a vector from an element MENU-COND-ELT of `msb-menu-cond'.
This takes the form:
-\[BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER]
+[BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER]
See `msb-menu-cond' for a description of its elements."
(let* ((list-symbol (make-symbol "-msb-buffer-list"))
(tmp-ih (and (> (length menu-cond-elt) 3)
(multi-flag nil)
function-info-list)
(setq function-info-list
- (loop for fi
- across function-info-vector
- if (and (setq result
- (eval (aref fi 1))) ;Test CONDITION
- (not (and (eq result 'no-multi)
- multi-flag))
- (progn (when (eq result 'multi)
- (setq multi-flag t))
- t))
- collect fi
- until (and result
- (not (eq result 'multi)))))
+ (cl-loop for fi
+ across function-info-vector
+ if (and (setq result
+ (eval (aref fi 1))) ;Test CONDITION
+ (not (and (eq result 'no-multi)
+ multi-flag))
+ (progn (when (eq result 'multi)
+ (setq multi-flag t))
+ t))
+ collect fi
+ until (and result
+ (not (eq result 'multi)))))
(when (and (not function-info-list)
(not result))
(error "No catch-all in msb-menu-cond!"))
(msb--add-to-menu buffer info max-buffer-name-length)))
(error (unless msb--error
(setq msb--error
- (format
+ (format-message
"In msb-menu-cond, error for buffer `%s'."
(buffer-name buffer)))
(error "%s" msb--error))))))
Example:
\(msb--aggregate-alist
- '((a . a1) (a . a2) (b . b1) (c . c3) (a . a4) (a . a3) (b . b3) (b . b2))
+ \\='((a . a1) (a . a2) (b . b1) (c . c3) (a . a4) (a . a3) (b . b3) (b . b2))
(function string=)
(lambda (item1 item2)
(string< (symbol-name item1) (symbol-name item2))))
(defun msb--mode-menu-cond ()
(let ((key msb-modes-key))
(mapcar (lambda (item)
- (incf key)
+ (cl-incf key)
(list `( eq major-mode (quote ,(car item)))
key
(concat (cdr item) " (%d)")))
(> msb-display-most-recently-used 0))
(let* ((buffers (cdr (buffer-list)))
(most-recently-used
- (loop with n = 0
- for buffer in buffers
- if (with-current-buffer buffer
- (and (not (msb-invisible-buffer-p))
- (not (eq major-mode 'dired-mode))))
- collect (with-current-buffer buffer
- (cons (funcall msb-item-handling-function
- buffer
- max-buffer-name-length)
- buffer))
- and do (incf n)
- until (>= n msb-display-most-recently-used))))
+ (cl-loop with n = 0
+ for buffer in buffers
+ if (with-current-buffer buffer
+ (and (not (msb-invisible-buffer-p))
+ (not (eq major-mode 'dired-mode))))
+ collect (with-current-buffer buffer
+ (cons (funcall msb-item-handling-function
+ buffer
+ max-buffer-name-length)
+ buffer))
+ and do (cl-incf n)
+ until (>= n msb-display-most-recently-used))))
(cons (if (stringp msb-most-recently-used-title)
(format msb-most-recently-used-title
(length most-recently-used))
(when file-buffers
(setq file-buffers
(mapcar (lambda (buffer-list)
- (list* msb-files-by-directory-sort-key
- (car buffer-list)
- (sort
- (mapcar (lambda (buffer)
- (cons (with-current-buffer buffer
- (funcall
- msb-item-handling-function
- buffer
- max-buffer-name-length))
- buffer))
- (cdr buffer-list))
- (lambda (item1 item2)
- (string< (car item1) (car item2))))))
+ `(,msb-files-by-directory-sort-key
+ ,(car buffer-list)
+ ,@(sort
+ (mapcar (lambda (buffer)
+ (cons (with-current-buffer buffer
+ (funcall
+ msb-item-handling-function
+ buffer
+ max-buffer-name-length))
+ buffer))
+ (cdr buffer-list))
+ (lambda (item1 item2)
+ (string< (car item1) (car item2))))))
(msb--choose-file-menu file-buffers))))
;; Now make the menu - a list of (TITLE . BUFFER-LIST)
(let* (menu
(most-recently-used
(msb--most-recently-used-menu max-buffer-name-length))
(others (nconc file-buffers
- (loop for elt
- across function-info-vector
- for value = (msb--create-sort-item elt)
- if value collect value))))
+ (cl-loop for elt
+ across function-info-vector
+ for value = (msb--create-sort-item elt)
+ if value collect value))))
(setq menu
(mapcar 'cdr ;Remove the SORT-KEY
;; Sort the menus - not the items.
(tmp-list nil))
(while (< count msb-max-menu-items)
(push (pop list) tmp-list)
- (incf count))
+ (cl-incf count))
(setq tmp-list (nreverse tmp-list))
(setq sub-name (concat (car (car tmp-list)) "..."))
(push (nconc (list mcount sub-name
list))
(defun msb--make-keymap-menu (raw-menu)
- (let ((end (cons '(nil) 'menu-bar-select-buffer))
+ (let ((end 'menu-bar-select-buffer)
(mcount 0))
(mapcar
(lambda (sub-menu)
(cons (buffer-name (cdr item))
(cons (car item) end)))
(cdr sub-menu))))
- (nconc (list (incf mcount) (car sub-menu)
+ (nconc (list (cl-incf mcount) (car sub-menu)
'keymap (car sub-menu))
(msb--split-menus buffers))))))
raw-menu)))
(setcdr (nthcdr msb-max-menu-items frames) nil))
(setq frames-menu
(nconc
- (list 'frame f-title '(nil) 'keymap f-title)
+ (list 'frame f-title 'keymap f-title)
(mapcar
(lambda (frame)
(nconc
(list (frame-parameter frame 'name)
- (frame-parameter frame 'name)
- (cons nil nil))
+ (frame-parameter frame 'name))
`(lambda ()
(interactive) (menu-bar-select-frame ,frame))))
frames)))))