Instantly share code, notes, and snippets.
Last active
June 28, 2019 06:00
-
Star
1
(1)
You must be signed in to star a gist -
Fork
0
(0)
You must be signed in to fork a gist
-
Save lawlist/651685e64bc4d471def7c87e0ef46a65 to your computer and use it in GitHub Desktop.
A port of the Xemacs buffers menu-bar feature that works with Emacs 26.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; https://gist.github.com/lawlist/651685e64bc4d471def7c87e0ef46a65 | |
;;; 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`. | |
(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) | |
(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))) | |
(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 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 | |
`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 (symbol-value-in-buffer 'major-mode buf1) | |
(symbol-value-in-buffer 'major-mode buf2)))) | |
(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 | |
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 (symbol-value-in-buffer 'major-mode buf1)) | |
(mode2 (symbol-value-in-buffer 'major-mode buf2))) | |
(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-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 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 | |
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'." | |
(if (string-match "%_. " item) | |
(substring item 4) | |
item)) | |
(defun menu-item-generate-accelerator-spec (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) | |
(concat | |
"%_" | |
(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 (symbol-value-in-buffer 'buffer-read-only buffer) | |
"%" " ") | |
(buffer-name buffer) | |
(buffer-size buffer) | |
(symbol-value-in-buffer 'mode-name buffer) | |
(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 n buffers-menu-omit-chars-list) | |
(buffer-name buffer))) | |
(provide 'buffer-menu) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment