1282 |
file)) |
file)) |
1283 |
(car elt))) |
(car elt))) |
1284 |
|
|
|
(defvar menu-bar-buffers-menu-list-buffers-entry nil) |
|
|
|
|
1285 |
(defun menu-bar-update-buffers (&optional force) |
(defun menu-bar-update-buffers (&optional force) |
1286 |
;; If user discards the Buffers item, play along. |
;; If user discards the Buffers item, play along. |
1287 |
(and (lookup-key (current-global-map) [menu-bar buffer]) |
(and (lookup-key (current-global-map) [menu-bar buffer]) |
1288 |
(or force (frame-or-buffer-changed-p)) |
(or force (frame-or-buffer-changed-p)) |
1289 |
(let ((buffers (buffer-list)) |
(let ((buffers (buffer-list)) |
1290 |
(frames (frame-list)) |
(frames (frame-list)) |
|
(maxlen 0) |
|
1291 |
buffers-menu frames-menu) |
buffers-menu frames-menu) |
1292 |
;; If requested, list only the N most recently selected buffers. |
;; If requested, list only the N most recently selected buffers. |
1293 |
(if (and (integerp buffers-menu-max-size) |
(if (and (integerp buffers-menu-max-size) |
1297 |
|
|
1298 |
;; Make the menu of buffers proper. |
;; Make the menu of buffers proper. |
1299 |
(setq buffers-menu |
(setq buffers-menu |
1300 |
(cons "Select Buffer" |
(let* ((buffer-list |
1301 |
(let* ((buffer-list |
(mapcar 'list buffers)) |
1302 |
(mapcar 'list buffers)) |
(menu-bar-update-buffers-maxbuf 0) |
1303 |
tail |
alist) |
1304 |
(menu-bar-update-buffers-maxbuf 0) |
;; Put into each element of buffer-list |
1305 |
alist |
;; the name for actual display, |
1306 |
head) |
;; perhaps truncated in the middle. |
1307 |
;; Put into each element of buffer-list |
(dolist (buf buffer-list) |
1308 |
;; the name for actual display, |
(let ((name (buffer-name (car buf)))) |
1309 |
;; perhaps truncated in the middle. |
(setcdr buf |
1310 |
(setq tail buffer-list) |
(if (> (length name) 27) |
1311 |
(while tail |
(concat (substring name 0 12) |
1312 |
(let ((name (buffer-name (car (car tail))))) |
"..." |
1313 |
(setcdr (car tail) |
(substring name -12)) |
1314 |
(if (> (length name) 27) |
name)))) |
1315 |
(concat (substring name 0 12) |
;; Compute the maximum length of any name. |
1316 |
"..." |
(dolist (buf buffer-list) |
1317 |
(substring name -12)) |
(unless (eq ?\ (aref (cdr buf) 0)) |
1318 |
name))) |
(setq menu-bar-update-buffers-maxbuf |
1319 |
(setq tail (cdr tail))) |
(max menu-bar-update-buffers-maxbuf |
1320 |
;; Compute the maximum length of any name. |
(length (cdr buf)))))) |
1321 |
(setq tail buffer-list) |
;; Set ALIST to an alist of the form |
1322 |
(while tail |
;; ITEM-STRING . BUFFER |
1323 |
(or (eq ?\ (aref (cdr (car tail)) 0)) |
(dolist (buf buffer-list) |
1324 |
(setq menu-bar-update-buffers-maxbuf |
(unless (eq ?\ (aref (cdr buf) 0)) |
1325 |
(max menu-bar-update-buffers-maxbuf |
(push (menu-bar-update-buffers-1 buf) alist))) |
1326 |
(length (cdr (car tail)))))) |
;; Now make the actual list of items, and add |
1327 |
(setq tail (cdr tail))) |
;; some miscellaneous buffer commands to the end. |
1328 |
;; Set ALIST to an alist of the form |
(mapcar (lambda (pair) |
1329 |
;; ITEM-STRING . BUFFER |
;; This is somewhat risque, to use |
1330 |
(setq tail buffer-list) |
;; the buffer name itself as the event |
1331 |
(while tail |
;; type to define, but it works. |
1332 |
(let ((elt (car tail))) |
;; It would not work to use the buffer |
1333 |
(or (eq ?\ (aref (cdr elt) 0)) |
;; since a buffer as an event has its |
1334 |
(setq alist (cons |
;; own meaning. |
1335 |
(menu-bar-update-buffers-1 elt) |
(nconc (list (buffer-name (cdr pair)) |
1336 |
alist))) |
(car pair) |
1337 |
(and alist (> (length (car (car alist))) maxlen) |
(cons nil nil)) |
1338 |
(setq maxlen (length (car (car alist)))))) |
'menu-bar-select-buffer)) |
1339 |
(setq tail (cdr tail))) |
(nreverse alist)))) |
|
(setq alist (nreverse alist)) |
|
|
;; Make the menu item for list-buffers |
|
|
;; or reuse the one we already have. |
|
|
;; The advantage in reusing one |
|
|
;; is that it already has the keyboard equivalent |
|
|
;; cached, so we save the time to look that up again. |
|
|
(or menu-bar-buffers-menu-list-buffers-entry |
|
|
(setq menu-bar-buffers-menu-list-buffers-entry |
|
|
(cons |
|
|
'list-buffers |
|
|
(cons |
|
|
"" |
|
|
'list-buffers)))) |
|
|
;; Update the item string for menu's new width. |
|
|
(setcar (cdr menu-bar-buffers-menu-list-buffers-entry) |
|
|
(concat (make-string (max (- (/ maxlen 2) 8) 0) |
|
|
?\ ) |
|
|
"List All Buffers")) |
|
|
;; Now make the actual list of items, |
|
|
;; ending with the list-buffers item. |
|
|
(nconc (mapcar (lambda (pair) |
|
|
;; This is somewhat risque, to use |
|
|
;; the buffer name itself as the event |
|
|
;; type to define, but it works. |
|
|
;; It would not work to use the buffer |
|
|
;; since a buffer as an event has its |
|
|
;; own meaning. |
|
|
(nconc (list (buffer-name (cdr pair)) |
|
|
(car pair) |
|
|
(cons nil nil)) |
|
|
'menu-bar-select-buffer)) |
|
|
alist) |
|
|
(list menu-bar-buffers-menu-list-buffers-entry))))) |
|
|
|
|
1340 |
|
|
1341 |
;; Make a Frames menu if we have more than one frame. |
;; Make a Frames menu if we have more than one frame. |
1342 |
(if (cdr frames) |
(when (cdr frames) |
1343 |
(let ((name (concat (make-string (max (- (/ maxlen 2) 3) 0) |
(let ((frames-menu |
1344 |
?\ ) |
(cons 'keymap |
1345 |
"Frames")) |
(cons "Select Frame" |
1346 |
(frames-menu |
(mapcar |
1347 |
(cons 'keymap |
(lambda (frame) |
1348 |
(cons "Select Frame" |
(nconc |
1349 |
(mapcar |
(list (frame-parameter frame 'name) |
1350 |
(lambda (frame) |
(frame-parameter frame 'name) |
1351 |
(nconc |
(cons nil nil)) |
1352 |
(list (frame-parameter frame 'name) |
'menu-bar-select-frame)) |
1353 |
(frame-parameter frame 'name) |
frames))))) |
1354 |
(cons nil nil)) |
;; Put it after the normal buffers |
1355 |
'menu-bar-select-frame)) |
(setq buffers-menu |
1356 |
frames))))) |
(nconc buffers-menu |
1357 |
;; Put it underneath the Buffers menu. |
`((frames-separator "--") |
1358 |
(setq buffers-menu (cons (cons 'frames (cons name frames-menu)) |
(frames menu-item "Frames" ,frames-menu)))))) |
1359 |
buffers-menu)))) |
|
1360 |
(if buffers-menu |
;; Add in some normal commands at the end of the menu |
1361 |
(setq buffers-menu (cons 'keymap buffers-menu))) |
(setq buffers-menu |
1362 |
|
(nconc buffers-menu |
1363 |
|
'((command-separator "--") |
1364 |
|
(select-named-buffer |
1365 |
|
menu-item |
1366 |
|
"Select Named Buffer..." |
1367 |
|
switch-to-buffer |
1368 |
|
:help "Prompt for a buffer name, and select that buffer in the current window") |
1369 |
|
(list-all-buffers |
1370 |
|
menu-item |
1371 |
|
"List All Buffers" |
1372 |
|
list-buffers |
1373 |
|
:help "Pop up a window listing all emacs buffers")))) |
1374 |
|
|
1375 |
|
(setq buffers-menu (cons 'keymap (cons "Select Buffer" buffers-menu))) |
1376 |
(define-key (current-global-map) [menu-bar buffer] |
(define-key (current-global-map) [menu-bar buffer] |
1377 |
(cons "Buffers" buffers-menu))))) |
(cons "Buffers" buffers-menu))))) |
1378 |
|
|