Skip to content

Instantly share code, notes, and snippets.

@lawlist

lawlist/buffer-menu.el

Last active June 28, 2019 06:00
Download ZIP

Revisions

  1. lawlist revised this gist Jun 28, 2019. 1 changed file with 2 additions and 617 deletions.
    619 changes: 2 additions & 617 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -1,618 +1,3 @@
    ;;; A port of the Xemacs buffers menu-bar feature that works with Emacs 26.
    This gist has been superseded by the following repository:

    ;;; https://gist.github.com/lawlist/651685e64bc4d471def7c87e0ef46a65

    ;;; https://emacs.stackexchange.com/q/44243/2287

    ;;; SCREENSHOTS:
    ;;;
    ;;; https://www.lawlist.com/images/buffer_menu_a.png
    ;;;
    ;;; https://www.lawlist.com/images/buffer_menu_b.png
    ;;;
    ;;; https://www.lawlist.com/images/buffer_menu_c.png
    ;;;
    ;;; https://www.lawlist.com/images/buffer_menu_d.png

    ;;; DESCRIPTION:
    ;;;
    ;;; The default setting of this library is a grouping of buffers by major-mode,
    ;;; which appear in a drop-down menu from the menu-bar. The function
    ;;; `menu-bar-update-buffers-2' can also be used to generate the same menu in a
    ;;; custom setup (assembly required), e.g., a mouse pop-up menu. The variable
    ;;; `buffers-menu-max-size' is defined in `menu-bar.el`, and this library uses it
    ;;; also in the same manner. As in the stock version, the symbol % indicates the
    ;;; buffer is read-only. Unlike the stock version, each buffer is numbered in
    ;;; the menu to help the user see how many buffers of that menu/submenu exist
    ;;; (within the buffer max limits, supra).
    ;;;
    ;;; - The variable setting of: (setq buffers-menu-submenus-for-groups-p t)
    ;;; places the buffers of each major-mode into a submenu of buffers.
    ;;;
    ;;; - The variable setting of: (setq complex-buffers-menu-p t)
    ;;; gives each buffer its own submenu of options: save buffer (if modified),
    ;;; save buffer as, kill buffer, switch to buffer, switch to buffer other
    ;;; frame. The user may set `buffers-menu-switch-to-buffer-function' to
    ;;; something other than `switch-to-buffer' if so desired.

    ;;; F.A.Q. (Frequently Asked Questions):
    ;;;
    ;;; Q: How is this different from what C-mouse-1 pops up?
    ;;;
    ;;; A: As to the built-in function `mouse-buffer-menu', and a default setting
    ;;; of 4 for the variable `mouse-buffer-menu-mode-mult', there is no obvious
    ;;; grouping of buffers by major-mode. Setting a value of 1 or 2 for the
    ;;; variable `mouse-buffer-menu-mode-mult' causes buffers to be grouped by
    ;;; major-mode and the buffers are available in submenus of the major-modes.
    ;;;
    ;;; Xemacs buffers-menu plugs-in to the menu-bar mechanism at the top of the
    ;;; screen. The default settings have no submenus, but nevertheless group
    ;;; buffers by major-mode and alphabetically within that major-mode.
    ;;; Major-modes are not identified as such, but the buffers within each
    ;;; major-mode grouping are separated from other major-mode groups with a
    ;;; divider line. When `buffers-menu-submenus-for-groups-p' is set to t,
    ;;; this is very similar to the built-in `mouse-buffer-menu' (when setting
    ;;; `mouse-buffer-menu-mode-mult' to a value of 1 or 0), except that the
    ;;; latter displays the path to file-visiting buffers. When setting
    ;;; `complex-buffers-menu-p' to t, each buffer gets its own submenu of
    ;;; options: `switch-to-buffer', `switch-to-buffer-other-frame',
    ;;; `save-buffer' (if modified), `write-file' of the current buffer which
    ;;; is referred to as Save As, and `kill-buffer'. There is presently no
    ;;; comparable submenu options when using the built-in `mouse-buffer-menu'.

    ;;; SETUP INSTRUCTIONS:
    ;;;
    ;;; Let us assume that Emacs has created a folder called .emacs.d inside your
    ;;; HOME directory and we will refer to it as "~/.emacs.d". Now, let us suppose
    ;;; that we want to create a directory for beta testing Lisp libraries -- to
    ;;; that end, we will create the folder beta-testing inside the ~/.emacs.d
    ;;; directory, and the path to that new directory that we just created will be
    ;;; ~/.emacs.d/beta-testing. Now, let us visit the Gist on the internet and we
    ;;; see a button "Download ZIP" and we go for it and download the zipped archive
    ;;; to a place such as our Desktop or other location of your choice. We then
    ;;; extract the file buffer-menu.el to the new directory we just created in the
    ;;; previous comment; i.e., ~/.emacs.d/beta-testing. The path to the file will
    ;;; now be ~/.emacs.d/beta-testing/buffer-menu.el. Now we must add the new
    ;;; directory to our load-path by adding the following line to our .emacs or
    ;;; init.el file: (add-to-list 'load-path "~/.emacs.d/beta-testing/")
    ;;; Somewhere after the line where we just added the folder beta-testing to our
    ;;; load-path, we can then put (require 'buffer-menu). There is no need to use
    ;;; a .el at the end. We are only beta testing!

    ;;; needed for things like `delete-if'
    (unless (fboundp 'delete-if)
    (require 'cl))

    (defcustom buffers-menu-xemacs-style t
    "*If non-nil, use the Xemacs style of handling the buffer menu-bar menu.
    *If nil, then use the plain-old default/stock way of handling this."
    :type 'boolean
    :group 'menu)

    (defvar buffers-menu-omit-chars-list '(?b ?p ?l ?d))

    ;;; The variable `buffers-menu-max-size' already exists in `menu-bar.el`.

    (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line
    "*The function to call to return a string to represent a buffer in
    the buffers menu. The function is passed a buffer and a number
    (starting with 1) indicating which buffer line in the menu is being
    processed and should return a string containing an accelerator
    spec. (Check out `menu-item-generate-accelerator-spec' as a convenient
    way of generating the accelerator specs.) The default value
    `format-buffers-menu-line' just returns the name of the buffer and
    uses the number as the accelerator. Also check out
    `slow-format-buffers-menu-line' which returns a whole bunch of info
    about a buffer.
    - Note: Gross Compatibility Hack: Older versions of this function prototype
    only expected one argument, not two. We deal gracefully with such
    functions by simply calling them with one argument and leaving out the
    line number. However, this may go away at any time, so make sure to
    update all of your functions of this type."
    :type 'function
    :group 'menu)

    (defcustom buffers-menu-sort-function
    'sort-buffers-menu-by-mode-then-alphabetically
    "*If non-nil, a function to sort the list of buffers in the buffers menu.
    It will be passed two arguments (two buffers to compare) and should return
    t if the first is \"less\" than the second. One possible value is
    `sort-buffers-menu-alphabetically'; another is
    `sort-buffers-menu-by-mode-then-alphabetically'."
    :type '(choice (const :tag "None" nil)
    function)
    :group 'menu)

    (defcustom buffers-menu-grouping-function
    'group-buffers-menu-by-mode-then-alphabetically
    "*If non-nil, a function to group buffers in the buffers menu together.
    It will be passed two arguments, successive members of the sorted buffers
    list after being passed through `buffers-menu-sort-function'. It should
    return non-nil if the second buffer begins a new group. The return value
    should be the name of the old group, which may be used in hierarchical
    buffers menus. The last invocation of the function contains nil as the
    second argument, so that the name of the last group can be determined.
    - The sensible values of this function are dependent on the value specified
    for `buffers-menu-sort-function'."
    :type '(choice (const :tag "None" nil)
    function)
    :group 'menu)

    (defcustom complex-buffers-menu-p nil
    "*If non-nil, the buffers menu will contain several commands.
    Commands will be presented as submenus of each buffer line. If this
    is false, then there will be only one command: select that buffer."
    :type 'boolean
    :group 'menu)

    (defcustom buffers-menu-submenus-for-groups-p nil
    "*If non-nil, the buffers menu will contain one submenu per group of buffers.
    The grouping function is specified in `buffers-menu-grouping-function'.
    If this is an integer, do not build submenus if the number of buffers
    is not larger than this value."
    :type '(choice (const :tag "No Subgroups" nil)
    (integer :tag "Max. submenus" 10)
    (sexp :format "%t\n" :tag "Allow Subgroups" :value t))
    :group 'menu)

    (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
    "*The function to call to select a buffer from the buffers menu.
    `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
    :type '(radio (function-item switch-to-buffer)
    (function-item pop-to-buffer)
    (function :tag "Other"))
    :group 'menu)

    (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
    "*If non-nil, a function specifying the buffers to omit from the buffers menu.
    This is passed a buffer and should return non-nil if the buffer should be
    omitted. The default value `buffers-menu-omit-invisible-buffers' omits
    buffers that are normally considered \"invisible\" (those whose name
    begins with a space)."
    :type '(choice (const :tag "None" nil)
    function)
    :group 'menu)

    (defvar buffers-menu-read-only-string "%"
    "The string that precedes the buffer name in the menu, which will be displayed
    if the buffer is read-only. There will be one (1) space between this string
    and the buffer name, unless the user chooses to modify the function named
    `format-buffers-menu-line', or assign a different function to the variable named
    `buffers-menu-format-buffer-line-function', which defaults to the former.
    - To the extent the user wishes a simple underscore character that precedes the
    the buffer name, this variable can be set to a pair of double-quotes with nothing
    in between \"\".")

    ;;; http://jkorpela.fi/chars/spaces.html
    ;;; Figure Space -- 'Tabular width', the width of digits.
    (defvar buffers-menu-read-write-string (char-to-string ?\u2007)
    "The string that precedes the buffer name in the menu, which will be displayed
    if the buffer is read-write. There will be one (1) space between this string
    and the buffer name, unless the user chooses to modify the function named
    `format-buffers-menu-line', or assign a different function to the variable named
    `buffers-menu-format-buffer-line-function', which defaults to the former.
    - To the extent the user wishes a simple underscore character that precedes the
    the buffer name, this variable can be set to a pair of double-quotes with nothing
    in between \"\".")

    (defun buffer-menu-save-buffer (buffer)
    (with-current-buffer buffer
    (save-buffer)))

    (defun buffer-menu-write-file (buffer)
    (with-current-buffer buffer
    (write-file (read-file-name
    (format "Write %s to file: "
    (buffer-name (current-buffer)))))))

    ;;; EXAMPLE -- NOT COMPLEX:
    ;;; '([(*Messages* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *Messages*))
    ;;; (*scratch* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *scratch*))])
    ;;;
    ;;; EXAMPLE -- COMPLEX:
    ;;; '((%_1 *Messages*
    ;;; menu-item
    ;;; %_1 *Messages* (keymap
    ;;; (unique-identifier-one
    ;;; menu-item
    ;;; Switch to *Messages*.
    ;;; (lambda nil (interactive) (funcall buffers-menu-switch-to-buffer-function *Messages*))
    ;;; :help Switch to *Messages*.)
    ;;; (unique-identifier-two
    ;;; menu-item
    ;;; Switch to *Messages*, other frame.
    ;;; (lambda nil (interactive) (funcall (quote switch-to-buffer-other-frame) *Messages*))
    ;;; :help Switch to *Messages*, other frame.)))
    ;;; (%_2 *scratch*
    ;;; menu-item
    ;;; %_2 *scratch* (keymap (unique-identifier-one
    ;;; menu-item
    ;;; Switch to *scratch*.
    ;;; (lambda nil (interactive) (funcall buffers-menu-switch-to-buffer-function *scratch*))
    ;;; :help Switch to *scratch*.)
    ;;; (unique-identifier-two
    ;;; menu-item
    ;;; Switch to *scratch*, other frame.
    ;;; (lambda nil (interactive) (funcall (quote switch-to-buffer-other-frame) *scratch*))
    ;;; :help Switch to *scratch*, other frame.))))
    ;;;
    (defsubst build-buffers-menu-internal (buffers)
    (let* ((n 0)
    (separator 0)
    line
    (lst
    (mapcar
    (lambda (buffer)
    (cond
    ((eq buffer t)
    (if complex-buffers-menu-p
    (progn
    ;;; The CAR of the separator must be unique.
    (incf separator)
    `(,separator "--"))
    '("--")))
    (t
    (setq n (1+ n))
    (setq line (funcall buffers-menu-format-buffer-line-function buffer n))
    (if complex-buffers-menu-p
    `(,line menu-item ,line
    ,(cons 'keymap
    (delq nil (list
    (list
    'unique-identifier-one
    'menu-item
    (format "Switch to %s." buffer)
    `(lambda ()
    (interactive)
    (funcall buffers-menu-switch-to-buffer-function ,(buffer-name buffer)))
    :help (format "Switch to %s." buffer))
    (if (eq buffers-menu-switch-to-buffer-function 'switch-to-buffer)
    (list
    'unique-identifier-two
    'menu-item
    (format "Switch to %s, other frame." buffer)
    `(lambda ()
    (interactive)
    (funcall 'switch-to-buffer-other-frame ,(buffer-name buffer)))
    :help (format "Switch to %s, other frame." buffer))
    nil)
    (if (and (buffer-modified-p buffer)
    (buffer-file-name buffer))
    (list
    'unique-identifier-three
    'menu-item
    (format "Save %s" buffer)
    `(lambda ()
    (interactive)
    (funcall 'buffer-menu-save-buffer ,(buffer-name buffer)))
    :help (format "Save %s" buffer))
    nil)
    (list
    'unique-identifier-four
    'menu-item
    (format "Save %s As..." buffer)
    `(lambda ()
    (interactive)
    (funcall 'buffer-menu-write-file ,(buffer-name buffer)))
    :help (format "Save %s As..." buffer))
    (list
    'unique-identifier-five
    'menu-item
    (format "Kill %s." buffer)
    `(lambda ()
    (interactive)
    (funcall 'kill-buffer ,(buffer-name buffer)))
    :help (format "Kill %s." buffer))))))
    (cons line
    `(lambda ()
    (interactive)
    (funcall buffers-menu-switch-to-buffer-function ,(buffer-name buffer))))))))
    buffers)))
    (if complex-buffers-menu-p
    lst
    (let ((buffers-vec (make-vector (length lst) nil))
    (i (length lst)))
    (dolist (elt (nreverse lst))
    (setq i (1- i))
    (aset buffers-vec i elt))
    (list buffers-vec)))))

    (defun buffers-menu-omit-invisible-buffers (buf)
    "For use as a value of `buffers-menu-omit-function'.
    Omits normally invisible buffers (those whose name begins with a space)."
    (not (null (string-match "\\` " (buffer-name buf)))))

    (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
    "For use as a value of `buffers-menu-grouping-function'.
    This groups buffers by major mode. It only really makes sense if
    `buffers-menu-sorting-function' is
    `sort-buffers-menu-by-mode-then-alphabetically'."
    (cond ((string-match "\\`*" (buffer-name buf1))
    (and (null buf2) "*Misc*"))
    ((or (null buf2)
    (string-match "\\`*" (buffer-name buf2))
    (not (eq (with-current-buffer buf1
    major-mode)
    (with-current-buffer buf2
    major-mode))))
    (with-current-buffer buf1
    major-mode))
    (t nil)))

    (defun sort-buffers-menu-alphabetically (buf1 buf2)
    "For use as a value of `buffers-menu-sort-function'.
    Sorts the buffers in alphabetical order by name, but puts buffers beginning
    with a star at the end of the list."
    (let* ((nam1 (buffer-name buf1))
    (nam2 (buffer-name buf2))
    (inv1p (not (null (string-match "\\` " nam1))))
    (inv2p (not (null (string-match "\\` " nam2))))
    (star1p (not (null (string-match "\\`*" nam1))))
    (star2p (not (null (string-match "\\`*" nam2)))))
    (cond ((not (eq inv1p inv2p))
    (not inv1p))
    ((not (eq star1p star2p))
    (not star1p))
    (t
    (string-lessp nam1 nam2)))))

    (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
    "For use as a value of `buffers-menu-sort-function'.
    Sorts first by major mode and then alphabetically by name, but puts buffers
    beginning with a star at the end of the list."
    (let* ((nam1 (buffer-name buf1))
    (nam2 (buffer-name buf2))
    (inv1p (not (null (string-match "\\` " nam1))))
    (inv2p (not (null (string-match "\\` " nam2))))
    (star1p (not (null (string-match "\\`*" nam1))))
    (star2p (not (null (string-match "\\`*" nam2))))
    (mode1 (with-current-buffer buf1
    major-mode))
    (mode2 (with-current-buffer buf2
    major-mode)))
    (cond ((not (eq inv1p inv2p))
    (not inv1p))
    ((not (eq star1p star2p))
    (not star1p))
    ((and star1p star2p (string-lessp nam1 nam2)))
    ((string-lessp mode1 mode2)
    t)
    ((string-lessp mode2 mode1)
    nil)
    (t
    (string-lessp nam1 nam2)))))

    (defun menu-item-generate-accelerator-spec (buffer n &optional omit-chars-list)
    "Return an accelerator specification for use with auto-generated menus.
    This should be concat'd onto the beginning of each menu line. The spec
    allows the Nth line to be selected by the number N. '0' is used for the
    10th line, and 'a' through 'z' are used for the following 26 lines.
    - If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
    which will not be used as accelerators."
    (let ((read-only (if (with-current-buffer buffer
    buffer-read-only)
    buffers-menu-read-only-string
    buffers-menu-read-write-string)))
    (cond
    ((< n 10) (concat read-only "_" (int-to-string n) " "))
    ((= n 10) (concat read-only "_0 "))
    ((<= n 36)
    (setq n (- n 10))
    (let ((m 0))
    (while (> n 0)
    (setq m (1+ m))
    (while (memq (+ m (- ?a 1)) omit-chars-list)
    (setq m (1+ m)))
    (setq n (1- n)))
    (if (<= m 26)
    (concat
    read-only
    "_"
    (char-to-string (+ m (- ?a 1)))
    " ")
    "")))
    (t ""))))

    ;; this version is too slow on some machines.
    ;; (vintage 1990, that is)
    (defun slow-format-buffers-menu-line (buffer n)
    "For use as a value of `buffers-menu-format-buffer-line-function'.
    This returns a string containing a bunch of info about the buffer."
    (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)
    (format "%s%s %-19s %6s %-15s %s"
    (if (buffer-modified-p buffer) "*" " ")
    (if (with-current-buffer buffer
    buffer-read-only)
    buffers-menu-read-only-string
    buffers-menu-read-write-string)
    (buffer-name buffer)
    (buffer-size buffer)
    (with-current-buffer buffer
    major-mode)
    (or (buffer-file-name buffer) ""))))

    (defun format-buffers-menu-line (buffer n)
    "For use as a value of `buffers-menu-format-buffer-line-function'.
    This just returns the buffer's name."
    (concat (menu-item-generate-accelerator-spec buffer n buffers-menu-omit-chars-list)
    " "
    (buffer-name buffer)))

    (defun menu-bar-update-buffers-2 ()
    "This is the menu filter for the top-level buffers \"Buffers\" menu.
    It dynamically creates a list of buffers to use as the contents of the menu.
    Only the most-recently-used few buffers will be listed on the menu, for
    efficiency reasons. You can control how many buffers will be shown by
    setting `buffers-menu-max-size'. You can control the text of the menu
    items by redefining the function `format-buffers-menu-line'."
    (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
    (and (integerp buffers-menu-max-size)
    (> buffers-menu-max-size 1)
    (> (length buffers) buffers-menu-max-size)
    ;; shorten list of buffers (not with submenus!)
    (not (and buffers-menu-grouping-function
    buffers-menu-submenus-for-groups-p))
    (setcdr (nthcdr buffers-menu-max-size buffers) nil))
    (if buffers-menu-sort-function
    (setq buffers (sort buffers buffers-menu-sort-function)))
    (if (and buffers-menu-grouping-function
    buffers-menu-submenus-for-groups-p
    (or (not (integerp buffers-menu-submenus-for-groups-p))
    (> (length buffers) buffers-menu-submenus-for-groups-p)))
    (let (groups groupnames current-group)
    (mapl
    (lambda (sublist)
    (let ((groupname (funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))))
    (setq current-group (cons (car sublist) current-group))
    (if groupname
    (progn
    (setq groups (cons (nreverse current-group)
    groups))
    (setq groupnames (cons groupname groupnames))
    (setq current-group nil)))))
    buffers)
    (setq buffers
    (mapcar*
    (lambda (groupname group)
    `(,groupname menu-item ,(format "%s" groupname)
    ,(cons 'keymap
    (build-buffers-menu-internal group))))
    (nreverse groupnames)
    (nreverse groups))))
    (if buffers-menu-grouping-function
    (progn
    (setq buffers
    (mapcon
    (lambda (sublist)
    (cond
    ((funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))
    (list (car sublist) t))
    (t (list (car sublist)))))
    buffers))
    ;; remove a trailing separator.
    (and (>= (length buffers) 2)
    (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
    (if (eq t (cadr lastcdr))
    (setcdr lastcdr nil))))))
    (setq buffers (build-buffers-menu-internal buffers)))
    buffers))

    (defun menu-bar-update-buffers (&optional force)
    ;; If user discards the Buffers item, play along.
    (and (lookup-key (current-global-map) [menu-bar buffer])
    (or force (frame-or-buffer-changed-p))
    (let ((buffers (buffer-list))
    (frames (frame-list))
    custom-entries
    buffers-menu)
    (if buffers-menu-xemacs-style
    (progn
    (setq custom-entries
    (list (list 'list-buffers
    'menu-item
    "List All Buffers"
    'list-buffers
    :help "Call the function `list-buffers'.")
    (list 'kill-this-buffer
    'menu-item
    (format "Delete Current Buffer: %s" (current-buffer))
    'kill-this-buffer
    :help "Call the function `kill-this-buffer'.")
    '(separator-one "--")))
    (setq buffers-menu (nconc custom-entries (menu-bar-update-buffers-2))))
    ;;; ELSE, use the plain old default way of handling the buffers menu.
    ;;;
    ;; Make the menu of buffers proper.
    (setq buffers-menu
    (let ((i 0)
    (limit (if (and (integerp buffers-menu-max-size)
    (> buffers-menu-max-size 1))
    buffers-menu-max-size most-positive-fixnum))
    alist)
    ;; Put into each element of buffer-list
    ;; the name for actual display,
    ;; perhaps truncated in the middle.
    (while buffers
    (let* ((buf (pop buffers))
    (name (buffer-name buf)))
    (unless (eq ?\s (aref name 0))
    (push (menu-bar-update-buffers-1
    (cons buf
    (if (and (integerp buffers-menu-buffer-name-length)
    (> (length name) buffers-menu-buffer-name-length))
    (concat
    (substring
    name 0 (/ buffers-menu-buffer-name-length 2))
    "..."
    (substring
    name (- (/ buffers-menu-buffer-name-length 2))))
    name)))
    alist)
    ;; If requested, list only the N most recently
    ;; selected buffers.
    (when (= limit (setq i (1+ i)))
    (setq buffers nil)))))
    (list (menu-bar-buffer-vector alist)))))
    ;; Make a Frames menu if we have more than one frame.
    (when (cdr frames)
    (let* ((frames-vec (make-vector (length frames) nil))
    (frames-menu
    (cons 'keymap
    (list "Select Frame" frames-vec)))
    (i 0))
    (dolist (frame frames)
    (aset frames-vec i
    (cons
    (frame-parameter frame 'name)
    `(lambda ()
    (interactive) (menu-bar-select-frame ,frame))))
    (setq i (1+ i)))
    ;; Put it after the normal buffers
    (setq buffers-menu
    (nconc buffers-menu
    `((frames-separator "--")
    (frames menu-item "Frames" ,frames-menu))))))
    ;; Add in some normal commands at the end of the menu. We use
    ;; the copy cached in `menu-bar-buffers-menu-command-entries'
    ;; if it's been set already. Note that we can't use constant
    ;; lists for the menu-entries, because the low-level menu-code
    ;; modifies them.
    (when (or force (null menu-bar-buffers-menu-command-entries))
    (setq menu-bar-buffers-menu-command-entries
    (delq nil
    (list
    '(command-separator "--")
    (list 'next-buffer
    'menu-item
    "Next Buffer"
    'next-buffer
    :help "Switch to the \"next\" buffer in a cyclic order")
    (list 'previous-buffer
    'menu-item
    "Previous Buffer"
    'previous-buffer
    :help "Switch to the \"previous\" buffer in a cyclic order")
    (list 'select-named-buffer
    'menu-item
    "Select Named Buffer..."
    'switch-to-buffer
    :help "Prompt for a buffer name, and select that buffer in the current window")
    (if (null buffers-menu-xemacs-style)
    (list 'list-all-buffers
    'menu-item
    "List All Buffers"
    'list-buffers
    :help "Pop up a window listing all Emacs buffers")
    nil)))))
    (setq buffers-menu
    (nconc buffers-menu menu-bar-buffers-menu-command-entries))
    ;; We used to "(define-key (current-global-map) [menu-bar buffer]"
    ;; but that did not do the right thing when the [menu-bar buffer]
    ;; entry above had been moved (e.g. to a parent keymap).
    (setcdr global-buffers-menu-map (cons "Buffers" buffers-menu)))))

    (menu-bar-update-buffers 'force)

    (provide 'buffer-menu)
    https://github.com/lawlist/buffer-menu
  2. lawlist revised this gist Aug 28, 2018. 1 changed file with 2 additions and 1 deletion.
    3 changes: 2 additions & 1 deletion buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -423,7 +423,8 @@ This returns a string containing a bunch of info about the buffer."
    (if (buffer-modified-p buffer) "*" " ")
    (if (with-current-buffer buffer
    buffer-read-only)
    "%" " ")
    buffers-menu-read-only-string
    buffers-menu-read-write-string)
    (buffer-name buffer)
    (buffer-size buffer)
    (with-current-buffer buffer
  3. lawlist revised this gist Aug 28, 2018. 1 changed file with 2 additions and 2 deletions.
    4 changes: 2 additions & 2 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -175,7 +175,7 @@ begins with a space)."

    (defvar buffers-menu-read-only-string "%"
    "The string that precedes the buffer name in the menu, which will be displayed
    if the buffer is read-only. There will be one (1) space between the this string
    if the buffer is read-only. There will be one (1) space between this string
    and the buffer name, unless the user chooses to modify the function named
    `format-buffers-menu-line', or assign a different function to the variable named
    `buffers-menu-format-buffer-line-function', which defaults to the former.
    @@ -187,7 +187,7 @@ in between \"\".")
    ;;; Figure Space -- 'Tabular width', the width of digits.
    (defvar buffers-menu-read-write-string (char-to-string ?\u2007)
    "The string that precedes the buffer name in the menu, which will be displayed
    if the buffer is read-write. There will be one (1) space between the this string
    if the buffer is read-write. There will be one (1) space between this string
    and the buffer name, unless the user chooses to modify the function named
    `format-buffers-menu-line', or assign a different function to the variable named
    `buffers-menu-format-buffer-line-function', which defaults to the former.
  4. lawlist revised this gist Aug 28, 2018. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -187,7 +187,7 @@ in between \"\".")
    ;;; Figure Space -- 'Tabular width', the width of digits.
    (defvar buffers-menu-read-write-string (char-to-string ?\u2007)
    "The string that precedes the buffer name in the menu, which will be displayed
    if the buffer is read-only. There will be one (1) space between the this string
    if the buffer is read-write. There will be one (1) space between the this string
    and the buffer name, unless the user chooses to modify the function named
    `format-buffers-menu-line', or assign a different function to the variable named
    `buffers-menu-format-buffer-line-function', which defaults to the former.
  5. lawlist revised this gist Aug 28, 2018. 1 changed file with 24 additions and 4 deletions.
    28 changes: 24 additions & 4 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -173,6 +173,28 @@ begins with a space)."
    function)
    :group 'menu)

    (defvar buffers-menu-read-only-string "%"
    "The string that precedes the buffer name in the menu, which will be displayed
    if the buffer is read-only. There will be one (1) space between the this string
    and the buffer name, unless the user chooses to modify the function named
    `format-buffers-menu-line', or assign a different function to the variable named
    `buffers-menu-format-buffer-line-function', which defaults to the former.
    - To the extent the user wishes a simple underscore character that precedes the
    the buffer name, this variable can be set to a pair of double-quotes with nothing
    in between \"\".")

    ;;; http://jkorpela.fi/chars/spaces.html
    ;;; Figure Space -- 'Tabular width', the width of digits.
    (defvar buffers-menu-read-write-string (char-to-string ?\u2007)
    "The string that precedes the buffer name in the menu, which will be displayed
    if the buffer is read-only. There will be one (1) space between the this string
    and the buffer name, unless the user chooses to modify the function named
    `format-buffers-menu-line', or assign a different function to the variable named
    `buffers-menu-format-buffer-line-function', which defaults to the former.
    - To the extent the user wishes a simple underscore character that precedes the
    the buffer name, this variable can be set to a pair of double-quotes with nothing
    in between \"\".")

    (defun buffer-menu-save-buffer (buffer)
    (with-current-buffer buffer
    (save-buffer)))
    @@ -369,10 +391,8 @@ allows the Nth line to be selected by the number N. '0' is used for the
    which will not be used as accelerators."
    (let ((read-only (if (with-current-buffer buffer
    buffer-read-only)
    "%"
    ;;; http://jkorpela.fi/chars/spaces.html
    ;;; Figure Space -- 'Tabular width', the width of digits.
    (char-to-string ?\u2007))))
    buffers-menu-read-only-string
    buffers-menu-read-write-string)))
    (cond
    ((< n 10) (concat read-only "_" (int-to-string n) " "))
    ((= n 10) (concat read-only "_0 "))
  6. lawlist revised this gist Aug 28, 2018. 1 changed file with 4 additions and 3 deletions.
    7 changes: 4 additions & 3 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -370,7 +370,9 @@ which will not be used as accelerators."
    (let ((read-only (if (with-current-buffer buffer
    buffer-read-only)
    "%"
    "")))
    ;;; http://jkorpela.fi/chars/spaces.html
    ;;; Figure Space -- 'Tabular width', the width of digits.
    (char-to-string ?\u2007))))
    (cond
    ((< n 10) (concat read-only "_" (int-to-string n) " "))
    ((= n 10) (concat read-only "_0 "))
    @@ -379,8 +381,7 @@ which will not be used as accelerators."
    (let ((m 0))
    (while (> n 0)
    (setq m (1+ m))
    (while (memq (+ m (- ?a 1))
    omit-chars-list)
    (while (memq (+ m (- ?a 1)) omit-chars-list)
    (setq m (1+ m)))
    (setq n (1- n)))
    (if (<= m 26)
  7. lawlist revised this gist Aug 27, 2018. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -490,7 +490,7 @@ items by redefining the function `format-buffers-menu-line'."
    (setq custom-entries
    (list (list 'list-buffers
    'menu-item
    "List All Buffer"
    "List All Buffers"
    'list-buffers
    :help "Call the function `list-buffers'.")
    (list 'kill-this-buffer
  8. lawlist revised this gist Aug 27, 2018. 1 changed file with 10 additions and 0 deletions.
    10 changes: 10 additions & 0 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -4,6 +4,16 @@

    ;;; https://emacs.stackexchange.com/q/44243/2287

    ;;; SCREENSHOTS:
    ;;;
    ;;; https://www.lawlist.com/images/buffer_menu_a.png
    ;;;
    ;;; https://www.lawlist.com/images/buffer_menu_b.png
    ;;;
    ;;; https://www.lawlist.com/images/buffer_menu_c.png
    ;;;
    ;;; https://www.lawlist.com/images/buffer_menu_d.png

    ;;; DESCRIPTION:
    ;;;
    ;;; The default setting of this library is a grouping of buffers by major-mode,
  9. lawlist revised this gist Aug 26, 2018. 1 changed file with 2 additions and 0 deletions.
    2 changes: 2 additions & 0 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -15,8 +15,10 @@
    ;;; buffer is read-only. Unlike the stock version, each buffer is numbered in
    ;;; the menu to help the user see how many buffers of that menu/submenu exist
    ;;; (within the buffer max limits, supra).
    ;;;
    ;;; - The variable setting of: (setq buffers-menu-submenus-for-groups-p t)
    ;;; places the buffers of each major-mode into a submenu of buffers.
    ;;;
    ;;; - The variable setting of: (setq complex-buffers-menu-p t)
    ;;; gives each buffer its own submenu of options: save buffer (if modified),
    ;;; save buffer as, kill buffer, switch to buffer, switch to buffer other
  10. lawlist revised this gist Aug 26, 2018. 1 changed file with 2 additions and 2 deletions.
    4 changes: 2 additions & 2 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -20,8 +20,8 @@
    ;;; - The variable setting of: (setq complex-buffers-menu-p t)
    ;;; gives each buffer its own submenu of options: save buffer (if modified),
    ;;; save buffer as, kill buffer, switch to buffer, switch to buffer other
    ;;; frame. The user may set`buffers-menu-switch-to-buffer-function' to
    ;;; something other than`switch-to-buffer' if so desired.
    ;;; frame. The user may set `buffers-menu-switch-to-buffer-function' to
    ;;; something other than `switch-to-buffer' if so desired.

    ;;; F.A.Q. (Frequently Asked Questions):
    ;;;
  11. lawlist revised this gist Aug 26, 2018. 1 changed file with 2 additions and 2 deletions.
    4 changes: 2 additions & 2 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -23,7 +23,7 @@
    ;;; frame. The user may set`buffers-menu-switch-to-buffer-function' to
    ;;; something other than`switch-to-buffer' if so desired.

    ;;; F.A.Q. (Frequently Asked Questions:
    ;;; F.A.Q. (Frequently Asked Questions):
    ;;;
    ;;; Q: How is this different from what C-mouse-1 pops up?
    ;;;
    @@ -41,7 +41,7 @@
    ;;; divider line. When `buffers-menu-submenus-for-groups-p' is set to t,
    ;;; this is very similar to the built-in `mouse-buffer-menu' (when setting
    ;;; `mouse-buffer-menu-mode-mult' to a value of 1 or 0), except that the
    ;;; latter displays the path to file-visiting buffers. When setting
    ;;; latter displays the path to file-visiting buffers. When setting
    ;;; `complex-buffers-menu-p' to t, each buffer gets its own submenu of
    ;;; options: `switch-to-buffer', `switch-to-buffer-other-frame',
    ;;; `save-buffer' (if modified), `write-file' of the current buffer which
  12. lawlist revised this gist Aug 26, 2018. 1 changed file with 45 additions and 1 deletion.
    46 changes: 45 additions & 1 deletion buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -4,7 +4,51 @@

    ;;; https://emacs.stackexchange.com/q/44243/2287

    ;;; BETA TESTING INSTRUCTIONS:
    ;;; DESCRIPTION:
    ;;;
    ;;; The default setting of this library is a grouping of buffers by major-mode,
    ;;; which appear in a drop-down menu from the menu-bar. The function
    ;;; `menu-bar-update-buffers-2' can also be used to generate the same menu in a
    ;;; custom setup (assembly required), e.g., a mouse pop-up menu. The variable
    ;;; `buffers-menu-max-size' is defined in `menu-bar.el`, and this library uses it
    ;;; also in the same manner. As in the stock version, the symbol % indicates the
    ;;; buffer is read-only. Unlike the stock version, each buffer is numbered in
    ;;; the menu to help the user see how many buffers of that menu/submenu exist
    ;;; (within the buffer max limits, supra).
    ;;; - The variable setting of: (setq buffers-menu-submenus-for-groups-p t)
    ;;; places the buffers of each major-mode into a submenu of buffers.
    ;;; - The variable setting of: (setq complex-buffers-menu-p t)
    ;;; gives each buffer its own submenu of options: save buffer (if modified),
    ;;; save buffer as, kill buffer, switch to buffer, switch to buffer other
    ;;; frame. The user may set`buffers-menu-switch-to-buffer-function' to
    ;;; something other than`switch-to-buffer' if so desired.

    ;;; F.A.Q. (Frequently Asked Questions:
    ;;;
    ;;; Q: How is this different from what C-mouse-1 pops up?
    ;;;
    ;;; A: As to the built-in function `mouse-buffer-menu', and a default setting
    ;;; of 4 for the variable `mouse-buffer-menu-mode-mult', there is no obvious
    ;;; grouping of buffers by major-mode. Setting a value of 1 or 2 for the
    ;;; variable `mouse-buffer-menu-mode-mult' causes buffers to be grouped by
    ;;; major-mode and the buffers are available in submenus of the major-modes.
    ;;;
    ;;; Xemacs buffers-menu plugs-in to the menu-bar mechanism at the top of the
    ;;; screen. The default settings have no submenus, but nevertheless group
    ;;; buffers by major-mode and alphabetically within that major-mode.
    ;;; Major-modes are not identified as such, but the buffers within each
    ;;; major-mode grouping are separated from other major-mode groups with a
    ;;; divider line. When `buffers-menu-submenus-for-groups-p' is set to t,
    ;;; this is very similar to the built-in `mouse-buffer-menu' (when setting
    ;;; `mouse-buffer-menu-mode-mult' to a value of 1 or 0), except that the
    ;;; latter displays the path to file-visiting buffers. When setting
    ;;; `complex-buffers-menu-p' to t, each buffer gets its own submenu of
    ;;; options: `switch-to-buffer', `switch-to-buffer-other-frame',
    ;;; `save-buffer' (if modified), `write-file' of the current buffer which
    ;;; is referred to as Save As, and `kill-buffer'. There is presently no
    ;;; comparable submenu options when using the built-in `mouse-buffer-menu'.

    ;;; SETUP INSTRUCTIONS:
    ;;;
    ;;; Let us assume that Emacs has created a folder called .emacs.d inside your
    ;;; HOME directory and we will refer to it as "~/.emacs.d". Now, let us suppose
  13. lawlist revised this gist Aug 26, 2018. 1 changed file with 1 addition and 2 deletions.
    3 changes: 1 addition & 2 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -470,8 +470,7 @@ items by redefining the function `format-buffers-menu-line'."
    "..."
    (substring
    name (- (/ buffers-menu-buffer-name-length 2))))
    name)
    ))
    name)))
    alist)
    ;; If requested, list only the N most recently
    ;; selected buffers.
  14. lawlist revised this gist Aug 26, 2018. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -118,7 +118,7 @@ begins with a space)."
    :group 'menu)

    (defun buffer-menu-save-buffer (buffer)
    (with-current-buffer
    (with-current-buffer buffer
    (save-buffer)))

    (defun buffer-menu-write-file (buffer)
  15. lawlist revised this gist Aug 26, 2018. 1 changed file with 2 additions and 4 deletions.
    6 changes: 2 additions & 4 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -118,13 +118,11 @@ begins with a space)."
    :group 'menu)

    (defun buffer-menu-save-buffer (buffer)
    (save-excursion
    (set-buffer buffer)
    (with-current-buffer
    (save-buffer)))

    (defun buffer-menu-write-file (buffer)
    (save-excursion
    (set-buffer buffer)
    (with-current-buffer buffer
    (write-file (read-file-name
    (format "Write %s to file: "
    (buffer-name (current-buffer)))))))
  16. lawlist revised this gist Aug 26, 2018. 1 changed file with 157 additions and 74 deletions.
    231 changes: 157 additions & 74 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -27,6 +27,12 @@
    (unless (fboundp 'delete-if)
    (require 'cl))

    (defcustom buffers-menu-xemacs-style t
    "*If non-nil, use the Xemacs style of handling the buffer menu-bar menu.
    *If nil, then use the plain-old default/stock way of handling this."
    :type 'boolean
    :group 'menu)

    (defvar buffers-menu-omit-chars-list '(?b ?p ?l ?d))

    ;;; The variable `buffers-menu-max-size' already exists in `menu-bar.el`.
    @@ -123,8 +129,37 @@ begins with a space)."
    (format "Write %s to file: "
    (buffer-name (current-buffer)))))))

    ;;; EXAMPLE: '([(*Messages* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *Messages*))
    ;;; (*scratch* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *scratch*))])
    ;;; EXAMPLE -- NOT COMPLEX:
    ;;; '([(*Messages* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *Messages*))
    ;;; (*scratch* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *scratch*))])
    ;;;
    ;;; EXAMPLE -- COMPLEX:
    ;;; '((%_1 *Messages*
    ;;; menu-item
    ;;; %_1 *Messages* (keymap
    ;;; (unique-identifier-one
    ;;; menu-item
    ;;; Switch to *Messages*.
    ;;; (lambda nil (interactive) (funcall buffers-menu-switch-to-buffer-function *Messages*))
    ;;; :help Switch to *Messages*.)
    ;;; (unique-identifier-two
    ;;; menu-item
    ;;; Switch to *Messages*, other frame.
    ;;; (lambda nil (interactive) (funcall (quote switch-to-buffer-other-frame) *Messages*))
    ;;; :help Switch to *Messages*, other frame.)))
    ;;; (%_2 *scratch*
    ;;; menu-item
    ;;; %_2 *scratch* (keymap (unique-identifier-one
    ;;; menu-item
    ;;; Switch to *scratch*.
    ;;; (lambda nil (interactive) (funcall buffers-menu-switch-to-buffer-function *scratch*))
    ;;; :help Switch to *scratch*.)
    ;;; (unique-identifier-two
    ;;; menu-item
    ;;; Switch to *scratch*, other frame.
    ;;; (lambda nil (interactive) (funcall (quote switch-to-buffer-other-frame) *scratch*))
    ;;; :help Switch to *scratch*, other frame.))))
    ;;;
    (defsubst build-buffers-menu-internal (buffers)
    (let* ((n 0)
    (separator 0)
    @@ -336,52 +371,55 @@ setting `buffers-menu-max-size'. You can control the text of the menu
    items by redefining the function `format-buffers-menu-line'."
    (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
    (and (integerp buffers-menu-max-size)
    (> buffers-menu-max-size 1)
    (> (length buffers) buffers-menu-max-size)
    ;; shorten list of buffers (not with submenus!)
    (not (and buffers-menu-grouping-function
    buffers-menu-submenus-for-groups-p))
    (setcdr (nthcdr buffers-menu-max-size buffers) nil))
    (> buffers-menu-max-size 1)
    (> (length buffers) buffers-menu-max-size)
    ;; shorten list of buffers (not with submenus!)
    (not (and buffers-menu-grouping-function
    buffers-menu-submenus-for-groups-p))
    (setcdr (nthcdr buffers-menu-max-size buffers) nil))
    (if buffers-menu-sort-function
    (setq buffers (sort buffers buffers-menu-sort-function)))
    (setq buffers (sort buffers buffers-menu-sort-function)))
    (if (and buffers-menu-grouping-function
    buffers-menu-submenus-for-groups-p
    (or (not (integerp buffers-menu-submenus-for-groups-p))
    (> (length buffers) buffers-menu-submenus-for-groups-p)))
    (let (groups groupnames current-group)
    (mapl
    #'(lambda (sublist)
    (let ((groupname (funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))))
    (setq current-group (cons (car sublist) current-group))
    (if groupname
    (progn
    (setq groups (cons (nreverse current-group)
    groups))
    (setq groupnames (cons groupname groupnames))
    (setq current-group nil)))))
    buffers)
    (setq buffers
    (mapcar*
    #'(lambda (groupname group)
    (cons groupname (build-buffers-menu-internal group)))
    (nreverse groupnames)
    (nreverse groups))))
    buffers-menu-submenus-for-groups-p
    (or (not (integerp buffers-menu-submenus-for-groups-p))
    (> (length buffers) buffers-menu-submenus-for-groups-p)))
    (let (groups groupnames current-group)
    (mapl
    (lambda (sublist)
    (let ((groupname (funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))))
    (setq current-group (cons (car sublist) current-group))
    (if groupname
    (progn
    (setq groups (cons (nreverse current-group)
    groups))
    (setq groupnames (cons groupname groupnames))
    (setq current-group nil)))))
    buffers)
    (setq buffers
    (mapcar*
    (lambda (groupname group)
    `(,groupname menu-item ,(format "%s" groupname)
    ,(cons 'keymap
    (build-buffers-menu-internal group))))
    (nreverse groupnames)
    (nreverse groups))))
    (if buffers-menu-grouping-function
    (progn
    (setq buffers
    (mapcon
    #'(lambda (sublist)
    (cond ((funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))
    (list (car sublist) t))
    (t (list (car sublist)))))
    buffers))
    ;; remove a trailing separator.
    (and (>= (length buffers) 2)
    (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
    (if (eq t (cadr lastcdr))
    (setcdr lastcdr nil))))))
    (progn
    (setq buffers
    (mapcon
    (lambda (sublist)
    (cond
    ((funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))
    (list (car sublist) t))
    (t (list (car sublist)))))
    buffers))
    ;; remove a trailing separator.
    (and (>= (length buffers) 2)
    (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
    (if (eq t (cadr lastcdr))
    (setcdr lastcdr nil))))))
    (setq buffers (build-buffers-menu-internal buffers)))
    buffers))

    @@ -393,19 +431,55 @@ items by redefining the function `format-buffers-menu-line'."
    (frames (frame-list))
    custom-entries
    buffers-menu)
    (setq custom-entries
    (list (list 'list-buffers
    'menu-item
    "List All Buffer"
    'list-buffers
    :help "Call the function `list-buffers'.")
    (list 'kill-this-buffer
    'menu-item
    (format "Delete Current Buffer: %s" (current-buffer))
    'kill-this-buffer
    :help "Call the function `kill-this-buffer'.")
    '(separator-one "--")))
    (setq buffers-menu (nconc custom-entries (menu-bar-update-buffers-2)))
    (if buffers-menu-xemacs-style
    (progn
    (setq custom-entries
    (list (list 'list-buffers
    'menu-item
    "List All Buffer"
    'list-buffers
    :help "Call the function `list-buffers'.")
    (list 'kill-this-buffer
    'menu-item
    (format "Delete Current Buffer: %s" (current-buffer))
    'kill-this-buffer
    :help "Call the function `kill-this-buffer'.")
    '(separator-one "--")))
    (setq buffers-menu (nconc custom-entries (menu-bar-update-buffers-2))))
    ;;; ELSE, use the plain old default way of handling the buffers menu.
    ;;;
    ;; Make the menu of buffers proper.
    (setq buffers-menu
    (let ((i 0)
    (limit (if (and (integerp buffers-menu-max-size)
    (> buffers-menu-max-size 1))
    buffers-menu-max-size most-positive-fixnum))
    alist)
    ;; Put into each element of buffer-list
    ;; the name for actual display,
    ;; perhaps truncated in the middle.
    (while buffers
    (let* ((buf (pop buffers))
    (name (buffer-name buf)))
    (unless (eq ?\s (aref name 0))
    (push (menu-bar-update-buffers-1
    (cons buf
    (if (and (integerp buffers-menu-buffer-name-length)
    (> (length name) buffers-menu-buffer-name-length))
    (concat
    (substring
    name 0 (/ buffers-menu-buffer-name-length 2))
    "..."
    (substring
    name (- (/ buffers-menu-buffer-name-length 2))))
    name)
    ))
    alist)
    ;; If requested, list only the N most recently
    ;; selected buffers.
    (when (= limit (setq i (1+ i)))
    (setq buffers nil)))))
    (list (menu-bar-buffer-vector alist)))))
    ;; Make a Frames menu if we have more than one frame.
    (when (cdr frames)
    (let* ((frames-vec (make-vector (length frames) nil))
    @@ -432,22 +506,31 @@ items by redefining the function `format-buffers-menu-line'."
    ;; modifies them.
    (when (or force (null menu-bar-buffers-menu-command-entries))
    (setq menu-bar-buffers-menu-command-entries
    (list '(command-separator "--")
    (list 'next-buffer
    'menu-item
    "Next Buffer"
    'next-buffer
    :help "Switch to the \"next\" buffer in a cyclic order")
    (list 'previous-buffer
    'menu-item
    "Previous Buffer"
    'previous-buffer
    :help "Switch to the \"previous\" buffer in a cyclic order")
    (list 'select-named-buffer
    'menu-item
    "Select Named Buffer..."
    'switch-to-buffer
    :help "Prompt for a buffer name, and select that buffer in the current window"))))
    (delq nil
    (list
    '(command-separator "--")
    (list 'next-buffer
    'menu-item
    "Next Buffer"
    'next-buffer
    :help "Switch to the \"next\" buffer in a cyclic order")
    (list 'previous-buffer
    'menu-item
    "Previous Buffer"
    'previous-buffer
    :help "Switch to the \"previous\" buffer in a cyclic order")
    (list 'select-named-buffer
    'menu-item
    "Select Named Buffer..."
    'switch-to-buffer
    :help "Prompt for a buffer name, and select that buffer in the current window")
    (if (null buffers-menu-xemacs-style)
    (list 'list-all-buffers
    'menu-item
    "List All Buffers"
    'list-buffers
    :help "Pop up a window listing all Emacs buffers")
    nil)))))
    (setq buffers-menu
    (nconc buffers-menu menu-bar-buffers-menu-command-entries))
    ;; We used to "(define-key (current-global-map) [menu-bar buffer]"
  17. lawlist revised this gist Aug 25, 2018. 1 changed file with 7 additions and 5 deletions.
    12 changes: 7 additions & 5 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -1,3 +1,5 @@
    ;;; A port of the Xemacs buffers menu-bar feature that works with Emacs 26.

    ;;; https://gist.github.com/lawlist/651685e64bc4d471def7c87e0ef46a65

    ;;; https://emacs.stackexchange.com/q/44243/2287
    @@ -127,7 +129,7 @@ begins with a space)."
    (let* ((n 0)
    (separator 0)
    line
    (newelt
    (lst
    (mapcar
    (lambda (buffer)
    (cond
    @@ -196,10 +198,10 @@ begins with a space)."
    (funcall buffers-menu-switch-to-buffer-function ,(buffer-name buffer))))))))
    buffers)))
    (if complex-buffers-menu-p
    newelt
    (let ((buffers-vec (make-vector (length newelt) nil))
    (i (length newelt)))
    (dolist (elt (nreverse newelt))
    lst
    (let ((buffers-vec (make-vector (length lst) nil))
    (i (length lst)))
    (dolist (elt (nreverse lst))
    (setq i (1- i))
    (aset buffers-vec i elt))
    (list buffers-vec)))))
  18. lawlist revised this gist Aug 25, 2018. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -74,7 +74,7 @@ for `buffers-menu-sort-function'."
    function)
    :group 'menu)

    (defcustom complex-buffers-menu-p t
    (defcustom complex-buffers-menu-p nil
    "*If non-nil, the buffers menu will contain several commands.
    Commands will be presented as submenus of each buffer line. If this
    is false, then there will be only one command: select that buffer."
  19. lawlist revised this gist Aug 25, 2018. 1 changed file with 91 additions and 61 deletions.
    152 changes: 91 additions & 61 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -74,7 +74,7 @@ for `buffers-menu-sort-function'."
    function)
    :group 'menu)

    (defcustom complex-buffers-menu-p nil
    (defcustom complex-buffers-menu-p t
    "*If non-nil, the buffers menu will contain several commands.
    Commands will be presented as submenus of each buffer line. If this
    is false, then there will be only one command: select that buffer."
    @@ -109,62 +109,100 @@ begins with a space)."
    function)
    :group 'menu)

    (defun buffer-menu-save-buffer (buffer)
    (save-excursion
    (set-buffer buffer)
    (save-buffer)))

    (defun buffer-menu-write-file (buffer)
    (save-excursion
    (set-buffer buffer)
    (write-file (read-file-name
    (format "Write %s to file: "
    (buffer-name (current-buffer)))))))

    ;;; EXAMPLE: '([(*Messages* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *Messages*))
    ;;; (*scratch* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *scratch*))])
    (defsubst build-buffers-menu-internal (buffers)
    (let* ((n 0)
    name
    line
    (newelt
    (mapcar
    #'(lambda (buffer)
    (if (eq buffer t)
    '("--")
    (setq n (1+ n))
    (setq line
    (let ((fn buffers-menu-format-buffer-line-function))
    (cond
    ((eq fn 'format-buffers-menu-line)
    (funcall fn buffer n))
    (t
    (funcall fn buffer)))))
    ;;; FIXME: @lawlist has not yet worked on the `complex-buffers-menu-p'.
    (if complex-buffers-menu-p
    (delq nil
    (list line
    (vector "S%_witch to Buffer"
    (list buffers-menu-switch-to-buffer-function
    (setq name (buffer-name buffer)))
    t)
    (if (eq buffers-menu-switch-to-buffer-function
    'switch-to-buffer)
    (vector "Switch to Buffer, Other %_Frame"
    (list 'switch-to-buffer-other-frame
    (setq name (buffer-name buffer)))
    t)
    nil)
    (if (and (buffer-modified-p buffer)
    (buffer-file-name buffer))
    (vector "%_Save Buffer"
    (list 'buffer-menu-save-buffer name) t)
    ["%_Save Buffer" nil nil]
    )
    (vector "Save %_As..."
    (list 'buffer-menu-write-file name) t)
    (vector "%_Delete Buffer" (list 'kill-buffer name)
    t)))
    (cons line
    `(lambda ()
    (interactive)
    (funcall buffers-menu-switch-to-buffer-function ,(buffer-name buffer)))))))
    buffers)))
    (let ((buffers-vec (make-vector (length newelt) nil))
    (i (length newelt)))
    (dolist (elt (nreverse newelt))
    (setq i (1- i))
    (aset buffers-vec i
    elt))
    (list buffers-vec))))
    (separator 0)
    line
    (newelt
    (mapcar
    (lambda (buffer)
    (cond
    ((eq buffer t)
    (if complex-buffers-menu-p
    (progn
    ;;; The CAR of the separator must be unique.
    (incf separator)
    `(,separator "--"))
    '("--")))
    (t
    (setq n (1+ n))
    (setq line (funcall buffers-menu-format-buffer-line-function buffer n))
    (if complex-buffers-menu-p
    `(,line menu-item ,line
    ,(cons 'keymap
    (delq nil (list
    (list
    'unique-identifier-one
    'menu-item
    (format "Switch to %s." buffer)
    `(lambda ()
    (interactive)
    (funcall buffers-menu-switch-to-buffer-function ,(buffer-name buffer)))
    :help (format "Switch to %s." buffer))
    (if (eq buffers-menu-switch-to-buffer-function 'switch-to-buffer)
    (list
    'unique-identifier-two
    'menu-item
    (format "Switch to %s, other frame." buffer)
    `(lambda ()
    (interactive)
    (funcall 'switch-to-buffer-other-frame ,(buffer-name buffer)))
    :help (format "Switch to %s, other frame." buffer))
    nil)
    (if (and (buffer-modified-p buffer)
    (buffer-file-name buffer))
    (list
    'unique-identifier-three
    'menu-item
    (format "Save %s" buffer)
    `(lambda ()
    (interactive)
    (funcall 'buffer-menu-save-buffer ,(buffer-name buffer)))
    :help (format "Save %s" buffer))
    nil)
    (list
    'unique-identifier-four
    'menu-item
    (format "Save %s As..." buffer)
    `(lambda ()
    (interactive)
    (funcall 'buffer-menu-write-file ,(buffer-name buffer)))
    :help (format "Save %s As..." buffer))
    (list
    'unique-identifier-five
    'menu-item
    (format "Kill %s." buffer)
    `(lambda ()
    (interactive)
    (funcall 'kill-buffer ,(buffer-name buffer)))
    :help (format "Kill %s." buffer))))))
    (cons line
    `(lambda ()
    (interactive)
    (funcall buffers-menu-switch-to-buffer-function ,(buffer-name buffer))))))))
    buffers)))
    (if complex-buffers-menu-p
    newelt
    (let ((buffers-vec (make-vector (length newelt) nil))
    (i (length newelt)))
    (dolist (elt (nreverse newelt))
    (setq i (1- i))
    (aset buffers-vec i elt))
    (list buffers-vec)))))

    (defun buffers-menu-omit-invisible-buffers (buf)
    "For use as a value of `buffers-menu-omit-function'.
    @@ -231,14 +269,6 @@ beginning with a star at the end of the list."
    (t
    (string-lessp nam1 nam2)))))

    (defun menu-item-strip-accelerator-spec (item)
    "Strip an auto-generated accelerator spec off of ITEM.
    ITEM should be a string. This removes specs added by
    `menu-item-generate-accelerator-spec'."
    (if (string-match "%_. " item)
    (substring item 4)
    item))

    (defun menu-item-generate-accelerator-spec (buffer n &optional omit-chars-list)
    "Return an accelerator specification for use with auto-generated menus.
    This should be concat'd onto the beginning of each menu line. The spec
  20. lawlist revised this gist Aug 24, 2018. 1 changed file with 103 additions and 112 deletions.
    215 changes: 103 additions & 112 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -22,7 +22,8 @@
    ;;; a .el at the end. We are only beta testing!

    ;;; needed for things like `delete-if'
    (require 'cl)
    (unless (fboundp 'delete-if)
    (require 'cl))

    (defvar buffers-menu-omit-chars-list '(?b ?p ?l ?d))

    @@ -131,35 +132,35 @@ begins with a space)."
    (if complex-buffers-menu-p
    (delq nil
    (list line
    (vector "S%_witch to Buffer"
    (list buffers-menu-switch-to-buffer-function
    (setq name (buffer-name buffer)))
    t)
    (if (eq buffers-menu-switch-to-buffer-function
    'switch-to-buffer)
    (vector "Switch to Buffer, Other %_Frame"
    (list 'switch-to-buffer-other-frame
    (setq name (buffer-name buffer)))
    t)
    nil)
    (if (and (buffer-modified-p buffer)
    (buffer-file-name buffer))
    (vector "%_Save Buffer"
    (list 'buffer-menu-save-buffer name) t)
    ["%_Save Buffer" nil nil]
    )
    (vector "Save %_As..."
    (list 'buffer-menu-write-file name) t)
    (vector "%_Delete Buffer" (list 'kill-buffer name)
    t)))
    (vector "S%_witch to Buffer"
    (list buffers-menu-switch-to-buffer-function
    (setq name (buffer-name buffer)))
    t)
    (if (eq buffers-menu-switch-to-buffer-function
    'switch-to-buffer)
    (vector "Switch to Buffer, Other %_Frame"
    (list 'switch-to-buffer-other-frame
    (setq name (buffer-name buffer)))
    t)
    nil)
    (if (and (buffer-modified-p buffer)
    (buffer-file-name buffer))
    (vector "%_Save Buffer"
    (list 'buffer-menu-save-buffer name) t)
    ["%_Save Buffer" nil nil]
    )
    (vector "Save %_As..."
    (list 'buffer-menu-write-file name) t)
    (vector "%_Delete Buffer" (list 'kill-buffer name)
    t)))
    (cons line
    `(lambda ()
    (interactive)
    (funcall buffers-menu-switch-to-buffer-function ,(buffer-name buffer)))))))
    buffers)))
    (let ((buffers-vec (make-vector (length newelt) nil))
    (i (length newelt)))
    (dolist (elt newelt)
    (dolist (elt (nreverse newelt))
    (setq i (1- i))
    (aset buffers-vec i
    elt))
    @@ -170,10 +171,6 @@ begins with a space)."
    Omits normally invisible buffers (those whose name begins with a space)."
    (not (null (string-match "\\` " (buffer-name buf)))))

    (defun symbol-value-in-buffer (_major-mode buf)
    (with-current-buffer buf
    major-mode))

    (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
    "For use as a value of `buffers-menu-grouping-function'.
    This groups buffers by major mode. It only really makes sense if
    @@ -183,9 +180,12 @@ This groups buffers by major mode. It only really makes sense if
    (and (null buf2) "*Misc*"))
    ((or (null buf2)
    (string-match "\\`*" (buffer-name buf2))
    (not (eq (symbol-value-in-buffer 'major-mode buf1)
    (symbol-value-in-buffer 'major-mode buf2))))
    (symbol-value-in-buffer 'mode-name buf1))
    (not (eq (with-current-buffer buf1
    major-mode)
    (with-current-buffer buf2
    major-mode))))
    (with-current-buffer buf1
    major-mode))
    (t nil)))

    (defun sort-buffers-menu-alphabetically (buf1 buf2)
    @@ -210,13 +210,15 @@ with a star at the end of the list."
    Sorts first by major mode and then alphabetically by name, but puts buffers
    beginning with a star at the end of the list."
    (let* ((nam1 (buffer-name buf1))
    (nam2 (buffer-name buf2))
    (inv1p (not (null (string-match "\\` " nam1))))
    (inv2p (not (null (string-match "\\` " nam2))))
    (star1p (not (null (string-match "\\`*" nam1))))
    (star2p (not (null (string-match "\\`*" nam2))))
    (mode1 (symbol-value-in-buffer 'major-mode buf1))
    (mode2 (symbol-value-in-buffer 'major-mode buf2)))
    (nam2 (buffer-name buf2))
    (inv1p (not (null (string-match "\\` " nam1))))
    (inv2p (not (null (string-match "\\` " nam2))))
    (star1p (not (null (string-match "\\`*" nam1))))
    (star2p (not (null (string-match "\\`*" nam2))))
    (mode1 (with-current-buffer buf1
    major-mode))
    (mode2 (with-current-buffer buf2
    major-mode)))
    (cond ((not (eq inv1p inv2p))
    (not inv1p))
    ((not (eq star1p star2p))
    @@ -229,65 +231,45 @@ beginning with a star at the end of the list."
    (t
    (string-lessp nam1 nam2)))))

    (defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
    "Add auto-generated accelerator specifications to a submenu.
    This can be used to add accelerators to the return value of a menu filter
    function. It correctly ignores unselectable items. It will destructively
    modify the list passed to it. If an item already has an auto-generated
    accelerator spec, this will be removed before the new one is added, making
    this function idempotent.
    - If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
    which will not be used as accelerators."
    (let ((n 0))
    (dolist (item list list)
    (cond
    ((vectorp item)
    (setq n (1+ n))
    (aset item 0
    (concat
    (menu-item-generate-accelerator-spec n omit-chars-list)
    (menu-item-strip-accelerator-spec (aref item 0)))))
    ((consp item)
    (setq n (1+ n))
    (setcar item
    (concat
    (menu-item-generate-accelerator-spec n omit-chars-list)
    (menu-item-strip-accelerator-spec (car item)))))))))

    (defun menu-item-strip-accelerator-spec (item)
    "Strip an auto-generated accelerator spec off of ITEM.
    ITEM should be a string. This removes specs added by
    `menu-item-generate-accelerator-spec' and `submenu-generate-accelerator-spec'."
    `menu-item-generate-accelerator-spec'."
    (if (string-match "%_. " item)
    (substring item 4)
    item))

    (defun menu-item-generate-accelerator-spec (n &optional omit-chars-list)
    (defun menu-item-generate-accelerator-spec (buffer n &optional omit-chars-list)
    "Return an accelerator specification for use with auto-generated menus.
    This should be concat'd onto the beginning of each menu line. The spec
    allows the Nth line to be selected by the number N. '0' is used for the
    10th line, and 'a' through 'z' are used for the following 26 lines.
    - If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
    which will not be used as accelerators."
    (cond
    ((< n 10) (concat "%_" (int-to-string n) " "))
    ((= n 10) "%_0 ")
    ((<= n 36)
    (setq n (- n 10))
    (let ((m 0))
    (while (> n 0)
    (setq m (1+ m))
    (while (memq (+ m (- ?a 1))
    omit-chars-list)
    (setq m (1+ m)))
    (setq n (1- n)))
    (if (<= m 26)
    (let ((read-only (if (with-current-buffer buffer
    buffer-read-only)
    "%"
    "")))
    (cond
    ((< n 10) (concat read-only "_" (int-to-string n) " "))
    ((= n 10) (concat read-only "_0 "))
    ((<= n 36)
    (setq n (- n 10))
    (let ((m 0))
    (while (> n 0)
    (setq m (1+ m))
    (while (memq (+ m (- ?a 1))
    omit-chars-list)
    (setq m (1+ m)))
    (setq n (1- n)))
    (if (<= m 26)
    (concat
    "%_"
    (char-to-string (+ m (- ?a 1)))
    " ")
    "")))
    (t "")))
    read-only
    "_"
    (char-to-string (+ m (- ?a 1)))
    " ")
    "")))
    (t ""))))

    ;; this version is too slow on some machines.
    ;; (vintage 1990, that is)
    @@ -297,19 +279,21 @@ This returns a string containing a bunch of info about the buffer."
    (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)
    (format "%s%s %-19s %6s %-15s %s"
    (if (buffer-modified-p buffer) "*" " ")
    (if (symbol-value-in-buffer 'buffer-read-only buffer)
    (if (with-current-buffer buffer
    buffer-read-only)
    "%" " ")
    (buffer-name buffer)
    (buffer-size buffer)
    (symbol-value-in-buffer 'mode-name buffer)
    (with-current-buffer buffer
    major-mode)
    (or (buffer-file-name buffer) ""))))

    (defun format-buffers-menu-line (buffer n)
    "For use as a value of `buffers-menu-format-buffer-line-function'.
    This just returns the buffer's name."
    (concat (buffer-name buffer)
    " "
    (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)))
    (concat (menu-item-generate-accelerator-spec buffer n buffers-menu-omit-chars-list)
    " "
    (buffer-name buffer)))

    (defun menu-bar-update-buffers-2 ()
    "This is the menu filter for the top-level buffers \"Buffers\" menu.
    @@ -374,9 +358,22 @@ items by redefining the function `format-buffers-menu-line'."
    (and (lookup-key (current-global-map) [menu-bar buffer])
    (or force (frame-or-buffer-changed-p))
    (let ((buffers (buffer-list))
    (frames (frame-list))
    buffers-menu)
    (setq buffers-menu (menu-bar-update-buffers-2))
    (frames (frame-list))
    custom-entries
    buffers-menu)
    (setq custom-entries
    (list (list 'list-buffers
    'menu-item
    "List All Buffer"
    'list-buffers
    :help "Call the function `list-buffers'.")
    (list 'kill-this-buffer
    'menu-item
    (format "Delete Current Buffer: %s" (current-buffer))
    'kill-this-buffer
    :help "Call the function `kill-this-buffer'.")
    '(separator-one "--")))
    (setq buffers-menu (nconc custom-entries (menu-bar-update-buffers-2)))
    ;; Make a Frames menu if we have more than one frame.
    (when (cdr frames)
    (let* ((frames-vec (make-vector (length frames) nil))
    @@ -393,38 +390,32 @@ items by redefining the function `format-buffers-menu-line'."
    (setq i (1+ i)))
    ;; Put it after the normal buffers
    (setq buffers-menu
    (nconc buffers-menu
    `((frames-separator "--")
    (frames menu-item "Frames" ,frames-menu))))))
    (nconc buffers-menu
    `((frames-separator "--")
    (frames menu-item "Frames" ,frames-menu))))))
    ;; Add in some normal commands at the end of the menu. We use
    ;; the copy cached in `menu-bar-buffers-menu-command-entries'
    ;; if it's been set already. Note that we can't use constant
    ;; lists for the menu-entries, because the low-level menu-code
    ;; modifies them.
    (unless menu-bar-buffers-menu-command-entries
    (when (or force (null menu-bar-buffers-menu-command-entries))
    (setq menu-bar-buffers-menu-command-entries
    (list '(command-separator "--")
    (list 'next-buffer
    'menu-item
    "Next Buffer"
    'next-buffer
    :help "Switch to the \"next\" buffer in a cyclic order")
    'menu-item
    "Next Buffer"
    'next-buffer
    :help "Switch to the \"next\" buffer in a cyclic order")
    (list 'previous-buffer
    'menu-item
    "Previous Buffer"
    'previous-buffer
    :help "Switch to the \"previous\" buffer in a cyclic order")
    'menu-item
    "Previous Buffer"
    'previous-buffer
    :help "Switch to the \"previous\" buffer in a cyclic order")
    (list 'select-named-buffer
    'menu-item
    "Select Named Buffer..."
    'switch-to-buffer
    :help "Prompt for a buffer name, and select that buffer in the current window")
    (list 'list-all-buffers
    'menu-item
    "List All Buffers"
    'list-buffers
    :help "Pop up a window listing all Emacs buffers"
    ))))
    'menu-item
    "Select Named Buffer..."
    'switch-to-buffer
    :help "Prompt for a buffer name, and select that buffer in the current window"))))
    (setq buffers-menu
    (nconc buffers-menu menu-bar-buffers-menu-command-entries))
    ;; We used to "(define-key (current-global-map) [menu-bar buffer]"
  21. lawlist revised this gist Aug 23, 2018. 1 changed file with 4 additions and 4 deletions.
    8 changes: 4 additions & 4 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -5,20 +5,20 @@
    ;;; BETA TESTING INSTRUCTIONS:
    ;;;
    ;;; Let us assume that Emacs has created a folder called .emacs.d inside your
    ;;; HOME directory and we will refer to it as "~/.emacs.d". Now, let us suppose
    ;;; HOME directory and we will refer to it as "~/.emacs.d". Now, let us suppose
    ;;; that we want to create a directory for beta testing Lisp libraries -- to
    ;;; that end, we will create the folder beta-testing inside the ~/.emacs.d
    ;;; directory, and the path to that new directory that we just created will be
    ;;; ~/.emacs.d/beta-testing. Now, let us visit the Gist on the internet and we
    ;;; see a button "Download ZIP" and we go for it and download the zipped archive
    ;;; to a place such as our Desktop or other location of your choice. We then
    ;;; extract the file buffer-menu.el to the new directory we just created in the
    ;;; previous comment; i.e., ~/.emacs.d/beta-testing. The path to the file will
    ;;; previous comment; i.e., ~/.emacs.d/beta-testing. The path to the file will
    ;;; now be ~/.emacs.d/beta-testing/buffer-menu.el. Now we must add the new
    ;;; directory to our load-path by adding the following line to our .emacs or
    ;;; init.el file: (add-to-list 'load-path "~/.emacs.d/beta-testing/")
    ;;; init.el file: (add-to-list 'load-path "~/.emacs.d/beta-testing/")
    ;;; Somewhere after the line where we just added the folder beta-testing to our
    ;;; load-path, we can then put (require 'buffer-menu). There is no need to use
    ;;; load-path, we can then put (require 'buffer-menu). There is no need to use
    ;;; a .el at the end. We are only beta testing!

    ;;; needed for things like `delete-if'
  22. lawlist revised this gist Aug 23, 2018. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -8,7 +8,7 @@
    ;;; HOME directory and we will refer to it as "~/.emacs.d". Now, let us suppose
    ;;; that we want to create a directory for beta testing Lisp libraries -- to
    ;;; that end, we will create the folder beta-testing inside the ~/.emacs.d
    ;;; directory, and the path to that new directory that we just crated will be
    ;;; directory, and the path to that new directory that we just created will be
    ;;; ~/.emacs.d/beta-testing. Now, let us visit the Gist on the internet and we
    ;;; see a button "Download ZIP" and we go for it and download the zipped archive
    ;;; to a place such as our Desktop or other location of your choice. We then
  23. lawlist revised this gist Aug 23, 2018. 1 changed file with 19 additions and 0 deletions.
    19 changes: 19 additions & 0 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -2,6 +2,25 @@

    ;;; https://emacs.stackexchange.com/q/44243/2287

    ;;; BETA TESTING INSTRUCTIONS:
    ;;;
    ;;; Let us assume that Emacs has created a folder called .emacs.d inside your
    ;;; HOME directory and we will refer to it as "~/.emacs.d". Now, let us suppose
    ;;; that we want to create a directory for beta testing Lisp libraries -- to
    ;;; that end, we will create the folder beta-testing inside the ~/.emacs.d
    ;;; directory, and the path to that new directory that we just crated will be
    ;;; ~/.emacs.d/beta-testing. Now, let us visit the Gist on the internet and we
    ;;; see a button "Download ZIP" and we go for it and download the zipped archive
    ;;; to a place such as our Desktop or other location of your choice. We then
    ;;; extract the file buffer-menu.el to the new directory we just created in the
    ;;; previous comment; i.e., ~/.emacs.d/beta-testing. The path to the file will
    ;;; now be ~/.emacs.d/beta-testing/buffer-menu.el. Now we must add the new
    ;;; directory to our load-path by adding the following line to our .emacs or
    ;;; init.el file: (add-to-list 'load-path "~/.emacs.d/beta-testing/")
    ;;; Somewhere after the line where we just added the folder beta-testing to our
    ;;; load-path, we can then put (require 'buffer-menu). There is no need to use
    ;;; a .el at the end. We are only beta testing!

    ;;; needed for things like `delete-if'
    (require 'cl)

  24. lawlist revised this gist Aug 23, 2018. 1 changed file with 0 additions and 2 deletions.
    2 changes: 0 additions & 2 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -5,8 +5,6 @@
    ;;; needed for things like `delete-if'
    (require 'cl)

    (defvar put-buffer-names-in-file-menu t)

    (defvar buffers-menu-omit-chars-list '(?b ?p ?l ?d))

    ;;; The variable `buffers-menu-max-size' already exists in `menu-bar.el`.
  25. lawlist revised this gist Aug 23, 2018. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -92,7 +92,7 @@ begins with a space)."
    :group 'menu)

    ;;; EXAMPLE: '([(*Messages* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *Messages*))
    ;;; (*scratch* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *scratch*))
    ;;; (*scratch* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *scratch*))])
    (defsubst build-buffers-menu-internal (buffers)
    (let* ((n 0)
    name
  26. lawlist revised this gist Aug 23, 2018. 1 changed file with 200 additions and 125 deletions.
    325 changes: 200 additions & 125 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -91,54 +91,62 @@ begins with a space)."
    function)
    :group 'menu)

    ;;; EXAMPLE: '([(*Messages* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *Messages*))
    ;;; (*scratch* *% lambda nil (interactive) (funcall menu-bar-select-buffer-function *scratch*))
    (defsubst build-buffers-menu-internal (buffers)
    (let (name line (n 0))
    (mapcar
    #'(lambda (buffer)
    (if (eq buffer t)
    "---"
    (setq n (1+ n))
    (setq line
    ; #### a truly Kyle-friendly hack.
    (let ((fn buffers-menu-format-buffer-line-function))
    (cond
    ((eq fn 'format-buffers-menu-line)
    (funcall fn buffer n))
    (t
    (funcall fn buffer)))))
    (if complex-buffers-menu-p
    (delq nil
    (list line
    (vector "S%_witch to Buffer"
    (list buffers-menu-switch-to-buffer-function
    (setq name (buffer-name buffer)))
    t)
    (if (eq buffers-menu-switch-to-buffer-function
    'switch-to-buffer)
    (vector "Switch to Buffer, Other %_Frame"
    (list 'switch-to-buffer-other-frame
    (setq name (buffer-name buffer)))
    t)
    nil)
    (if (and (buffer-modified-p buffer)
    (buffer-file-name buffer))
    (vector "%_Save Buffer"
    (list 'buffer-menu-save-buffer name) t)
    ["%_Save Buffer" nil nil]
    )
    (vector "Save %_As..."
    (list 'buffer-menu-write-file name) t)
    (vector "%_Delete Buffer" (list 'kill-buffer name)
    t)))
    ;; #### We don't want buffer names to be translated,
    ;; #### so we put the buffer name in the suffix.
    ;; #### Also, avoid losing with non-ASCII buffer names.
    ;; #### We still lose, however, if complex-buffers-menu-p. --mrb
    (vector ""
    (list buffers-menu-switch-to-buffer-function
    (buffer-name buffer))
    t line))))
    buffers)))
    (let* ((n 0)
    name
    line
    (newelt
    (mapcar
    #'(lambda (buffer)
    (if (eq buffer t)
    '("--")
    (setq n (1+ n))
    (setq line
    (let ((fn buffers-menu-format-buffer-line-function))
    (cond
    ((eq fn 'format-buffers-menu-line)
    (funcall fn buffer n))
    (t
    (funcall fn buffer)))))
    ;;; FIXME: @lawlist has not yet worked on the `complex-buffers-menu-p'.
    (if complex-buffers-menu-p
    (delq nil
    (list line
    (vector "S%_witch to Buffer"
    (list buffers-menu-switch-to-buffer-function
    (setq name (buffer-name buffer)))
    t)
    (if (eq buffers-menu-switch-to-buffer-function
    'switch-to-buffer)
    (vector "Switch to Buffer, Other %_Frame"
    (list 'switch-to-buffer-other-frame
    (setq name (buffer-name buffer)))
    t)
    nil)
    (if (and (buffer-modified-p buffer)
    (buffer-file-name buffer))
    (vector "%_Save Buffer"
    (list 'buffer-menu-save-buffer name) t)
    ["%_Save Buffer" nil nil]
    )
    (vector "Save %_As..."
    (list 'buffer-menu-write-file name) t)
    (vector "%_Delete Buffer" (list 'kill-buffer name)
    t)))
    (cons line
    `(lambda ()
    (interactive)
    (funcall buffers-menu-switch-to-buffer-function ,(buffer-name buffer)))))))
    buffers)))
    (let ((buffers-vec (make-vector (length newelt) nil))
    (i (length newelt)))
    (dolist (elt newelt)
    (setq i (1- i))
    (aset buffers-vec i
    elt))
    (list buffers-vec))))

    (defun buffers-menu-omit-invisible-buffers (buf)
    "For use as a value of `buffers-menu-omit-function'.
    @@ -204,64 +212,6 @@ beginning with a star at the end of the list."
    (t
    (string-lessp nam1 nam2)))))

    (defun menu-bar-update-buffers (&optional _force)
    "This is the menu filter for the top-level buffers \"Buffers\" menu.
    It dynamically creates a list of buffers to use as the contents of the menu.
    Only the most-recently-used few buffers will be listed on the menu, for
    efficiency reasons. You can control how many buffers will be shown by
    setting `buffers-menu-max-size'. You can control the text of the menu
    items by redefining the function `format-buffers-menu-line'."
    (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
    (and (integerp buffers-menu-max-size)
    (> buffers-menu-max-size 1)
    (> (length buffers) buffers-menu-max-size)
    ;; shorten list of buffers (not with submenus!)
    (not (and buffers-menu-grouping-function
    buffers-menu-submenus-for-groups-p))
    (setcdr (nthcdr buffers-menu-max-size buffers) nil))
    (if buffers-menu-sort-function
    (setq buffers (sort buffers buffers-menu-sort-function)))
    (if (and buffers-menu-grouping-function
    buffers-menu-submenus-for-groups-p
    (or (not (integerp buffers-menu-submenus-for-groups-p))
    (> (length buffers) buffers-menu-submenus-for-groups-p)))
    (let (groups groupnames current-group)
    (mapl
    #'(lambda (sublist)
    (let ((groupname (funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))))
    (setq current-group (cons (car sublist) current-group))
    (if groupname
    (progn
    (setq groups (cons (nreverse current-group)
    groups))
    (setq groupnames (cons groupname groupnames))
    (setq current-group nil)))))
    buffers)
    (setq buffers
    (mapcar*
    #'(lambda (groupname group)
    (cons groupname (build-buffers-menu-internal group)))
    (nreverse groupnames)
    (nreverse groups))))
    (if buffers-menu-grouping-function
    (progn
    (setq buffers
    (mapcon
    #'(lambda (sublist)
    (cond ((funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))
    (list (car sublist) t))
    (t (list (car sublist)))))
    buffers))
    ;; remove a trailing separator.
    (and (>= (length buffers) 2)
    (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
    (if (eq t (cadr lastcdr))
    (setcdr lastcdr nil))))))
    (setq buffers (build-buffers-menu-internal buffers)))
    buffers))

    (defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
    "Add auto-generated accelerator specifications to a submenu.
    This can be used to add accelerators to the return value of a menu filter
    @@ -302,24 +252,25 @@ allows the Nth line to be selected by the number N. '0' is used for the
    10th line, and 'a' through 'z' are used for the following 26 lines.
    - If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
    which will not be used as accelerators."
    (cond ((< n 10) (concat "%_" (int-to-string n) " "))
    ((= n 10) "%_0 ")
    ((<= n 36)
    (setq n (- n 10))
    (let ((m 0))
    (while (> n 0)
    (setq m (1+ m))
    (while (memq (+ m (- ?a 1))
    omit-chars-list)
    (setq m (1+ m)))
    (setq n (1- n)))
    (if (<= m 26)
    (concat
    "%_"
    (char-to-string (+ m (- ?a 1)))
    " ")
    "")))
    (t "")))
    (cond
    ((< n 10) (concat "%_" (int-to-string n) " "))
    ((= n 10) "%_0 ")
    ((<= n 36)
    (setq n (- n 10))
    (let ((m 0))
    (while (> n 0)
    (setq m (1+ m))
    (while (memq (+ m (- ?a 1))
    omit-chars-list)
    (setq m (1+ m)))
    (setq n (1- n)))
    (if (<= m 26)
    (concat
    "%_"
    (char-to-string (+ m (- ?a 1)))
    " ")
    "")))
    (t "")))

    ;; this version is too slow on some machines.
    ;; (vintage 1990, that is)
    @@ -339,7 +290,131 @@ This returns a string containing a bunch of info about the buffer."
    (defun format-buffers-menu-line (buffer n)
    "For use as a value of `buffers-menu-format-buffer-line-function'.
    This just returns the buffer's name."
    (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)
    (buffer-name buffer)))
    (concat (buffer-name buffer)
    " "
    (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)))

    (defun menu-bar-update-buffers-2 ()
    "This is the menu filter for the top-level buffers \"Buffers\" menu.
    It dynamically creates a list of buffers to use as the contents of the menu.
    Only the most-recently-used few buffers will be listed on the menu, for
    efficiency reasons. You can control how many buffers will be shown by
    setting `buffers-menu-max-size'. You can control the text of the menu
    items by redefining the function `format-buffers-menu-line'."
    (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
    (and (integerp buffers-menu-max-size)
    (> buffers-menu-max-size 1)
    (> (length buffers) buffers-menu-max-size)
    ;; shorten list of buffers (not with submenus!)
    (not (and buffers-menu-grouping-function
    buffers-menu-submenus-for-groups-p))
    (setcdr (nthcdr buffers-menu-max-size buffers) nil))
    (if buffers-menu-sort-function
    (setq buffers (sort buffers buffers-menu-sort-function)))
    (if (and buffers-menu-grouping-function
    buffers-menu-submenus-for-groups-p
    (or (not (integerp buffers-menu-submenus-for-groups-p))
    (> (length buffers) buffers-menu-submenus-for-groups-p)))
    (let (groups groupnames current-group)
    (mapl
    #'(lambda (sublist)
    (let ((groupname (funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))))
    (setq current-group (cons (car sublist) current-group))
    (if groupname
    (progn
    (setq groups (cons (nreverse current-group)
    groups))
    (setq groupnames (cons groupname groupnames))
    (setq current-group nil)))))
    buffers)
    (setq buffers
    (mapcar*
    #'(lambda (groupname group)
    (cons groupname (build-buffers-menu-internal group)))
    (nreverse groupnames)
    (nreverse groups))))
    (if buffers-menu-grouping-function
    (progn
    (setq buffers
    (mapcon
    #'(lambda (sublist)
    (cond ((funcall buffers-menu-grouping-function
    (car sublist) (cadr sublist))
    (list (car sublist) t))
    (t (list (car sublist)))))
    buffers))
    ;; remove a trailing separator.
    (and (>= (length buffers) 2)
    (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
    (if (eq t (cadr lastcdr))
    (setcdr lastcdr nil))))))
    (setq buffers (build-buffers-menu-internal buffers)))
    buffers))

    (defun menu-bar-update-buffers (&optional force)
    ;; If user discards the Buffers item, play along.
    (and (lookup-key (current-global-map) [menu-bar buffer])
    (or force (frame-or-buffer-changed-p))
    (let ((buffers (buffer-list))
    (frames (frame-list))
    buffers-menu)
    (setq buffers-menu (menu-bar-update-buffers-2))
    ;; Make a Frames menu if we have more than one frame.
    (when (cdr frames)
    (let* ((frames-vec (make-vector (length frames) nil))
    (frames-menu
    (cons 'keymap
    (list "Select Frame" frames-vec)))
    (i 0))
    (dolist (frame frames)
    (aset frames-vec i
    (cons
    (frame-parameter frame 'name)
    `(lambda ()
    (interactive) (menu-bar-select-frame ,frame))))
    (setq i (1+ i)))
    ;; Put it after the normal buffers
    (setq buffers-menu
    (nconc buffers-menu
    `((frames-separator "--")
    (frames menu-item "Frames" ,frames-menu))))))
    ;; Add in some normal commands at the end of the menu. We use
    ;; the copy cached in `menu-bar-buffers-menu-command-entries'
    ;; if it's been set already. Note that we can't use constant
    ;; lists for the menu-entries, because the low-level menu-code
    ;; modifies them.
    (unless menu-bar-buffers-menu-command-entries
    (setq menu-bar-buffers-menu-command-entries
    (list '(command-separator "--")
    (list 'next-buffer
    'menu-item
    "Next Buffer"
    'next-buffer
    :help "Switch to the \"next\" buffer in a cyclic order")
    (list 'previous-buffer
    'menu-item
    "Previous Buffer"
    'previous-buffer
    :help "Switch to the \"previous\" buffer in a cyclic order")
    (list 'select-named-buffer
    'menu-item
    "Select Named Buffer..."
    'switch-to-buffer
    :help "Prompt for a buffer name, and select that buffer in the current window")
    (list 'list-all-buffers
    'menu-item
    "List All Buffers"
    'list-buffers
    :help "Pop up a window listing all Emacs buffers"
    ))))
    (setq buffers-menu
    (nconc buffers-menu menu-bar-buffers-menu-command-entries))
    ;; We used to "(define-key (current-global-map) [menu-bar buffer]"
    ;; but that did not do the right thing when the [menu-bar buffer]
    ;; entry above had been moved (e.g. to a parent keymap).
    (setcdr global-buffers-menu-map (cons "Buffers" buffers-menu)))))

    (menu-bar-update-buffers 'force)

    (provide 'buffer-menu)
  27. lawlist revised this gist Aug 22, 2018. 1 changed file with 2 additions and 0 deletions.
    2 changes: 2 additions & 0 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -1,5 +1,7 @@
    ;;; https://gist.github.com/lawlist/651685e64bc4d471def7c87e0ef46a65

    ;;; https://emacs.stackexchange.com/q/44243/2287

    ;;; needed for things like `delete-if'
    (require 'cl)

  28. lawlist revised this gist Aug 22, 2018. 1 changed file with 0 additions and 7 deletions.
    7 changes: 0 additions & 7 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -260,13 +260,6 @@ items by redefining the function `format-buffers-menu-line'."
    (setq buffers (build-buffers-menu-internal buffers)))
    buffers))

    (defun Menubar-items-truncate-list (list n)
    (mapcar #'(lambda (x)
    (if (<= (length x) 50) x (concat "..." (substring x -50))))
    (if (<= (length list) n)
    list
    (butlast list (- (length list) n)))))

    (defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
    "Add auto-generated accelerator specifications to a submenu.
    This can be used to add accelerators to the return value of a menu filter
  29. lawlist revised this gist Aug 22, 2018. 1 changed file with 0 additions and 2 deletions.
    2 changes: 0 additions & 2 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -161,7 +161,6 @@ This groups buffers by major mode. It only really makes sense if
    (symbol-value-in-buffer 'mode-name buf1))
    (t nil)))


    (defun sort-buffers-menu-alphabetically (buf1 buf2)
    "For use as a value of `buffers-menu-sort-function'.
    Sorts the buffers in alphabetical order by name, but puts buffers beginning
    @@ -327,7 +326,6 @@ which will not be used as accelerators."
    "")))
    (t "")))


    ;; this version is too slow on some machines.
    ;; (vintage 1990, that is)
    (defun slow-format-buffers-menu-line (buffer n)
  30. lawlist revised this gist Aug 22, 2018. 1 changed file with 10 additions and 11 deletions.
    21 changes: 10 additions & 11 deletions buffer-menu.el
    View file
    Original file line number Diff line number Diff line change
    @@ -1,8 +1,7 @@
    (require 'cl) ;; needed for things like `delete-if'
    ;;; https://gist.github.com/lawlist/651685e64bc4d471def7c87e0ef46a65

    (defgroup buffers-menu nil
    "Customization of `Buffers' menu."
    :group 'menu)
    ;;; needed for things like `delete-if'
    (require 'cl)

    (defvar put-buffer-names-in-file-menu t)

    @@ -27,7 +26,7 @@ functions by simply calling them with one argument and leaving out the
    line number. However, this may go away at any time, so make sure to
    update all of your functions of this type."
    :type 'function
    :group 'buffers-menu)
    :group 'menu)

    (defcustom buffers-menu-sort-function
    'sort-buffers-menu-by-mode-then-alphabetically
    @@ -38,7 +37,7 @@ t if the first is \"less\" than the second. One possible value is
    `sort-buffers-menu-by-mode-then-alphabetically'."
    :type '(choice (const :tag "None" nil)
    function)
    :group 'buffers-menu)
    :group 'menu)

    (defcustom buffers-menu-grouping-function
    'group-buffers-menu-by-mode-then-alphabetically
    @@ -53,14 +52,14 @@ second argument, so that the name of the last group can be determined.
    for `buffers-menu-sort-function'."
    :type '(choice (const :tag "None" nil)
    function)
    :group 'buffers-menu)
    :group 'menu)

    (defcustom complex-buffers-menu-p nil
    "*If non-nil, the buffers menu will contain several commands.
    Commands will be presented as submenus of each buffer line. If this
    is false, then there will be only one command: select that buffer."
    :type 'boolean
    :group 'buffers-menu)
    :group 'menu)

    (defcustom buffers-menu-submenus-for-groups-p nil
    "*If non-nil, the buffers menu will contain one submenu per group of buffers.
    @@ -70,15 +69,15 @@ is not larger than this value."
    :type '(choice (const :tag "No Subgroups" nil)
    (integer :tag "Max. submenus" 10)
    (sexp :format "%t\n" :tag "Allow Subgroups" :value t))
    :group 'buffers-menu)
    :group 'menu)

    (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
    "*The function to call to select a buffer from the buffers menu.
    `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
    :type '(radio (function-item switch-to-buffer)
    (function-item pop-to-buffer)
    (function :tag "Other"))
    :group 'buffers-menu)
    :group 'menu)

    (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
    "*If non-nil, a function specifying the buffers to omit from the buffers menu.
    @@ -88,7 +87,7 @@ buffers that are normally considered \"invisible\" (those whose name
    begins with a space)."
    :type '(choice (const :tag "None" nil)
    function)
    :group 'buffers-menu)
    :group 'menu)

    (defsubst build-buffers-menu-internal (buffers)
    (let (name line (n 0))