- (while tail
- (let ((elt (car tail)))
- (if (not (string-match "^ "
- (buffer-name elt)))
- (setq head (cons
- (cons
- (format
- "%14s %s"
- (buffer-name elt)
- (or (buffer-file-name elt) ""))
- elt)
- head)))
- (and head (> (length (car (car head))) maxlen)
- (setq maxlen (length (car (car head))))))
- (setq tail (cdr tail)))
- (nconc (reverse head)
- (list (cons (concat (make-string (- (/ maxlen 2) 8) ?\ )
- "List All Buffers")
- 'list-buffers)))))))
-
-
- (let ((buf (x-popup-menu (if (listp event) event
- (cons '(0 0) (selected-frame)))
- menu))
- (window (and (listp event) (posn-window (event-start event)))))
- (if (eq buf 'list-buffers)
- (list-buffers)
- (if buf
- (if complex-buffers-menu-p
- (let ((action (x-popup-menu (if (listp event) event
- (cons '(0 0) (selected-frame)))
- '("Buffer Action"
- (""
- ("Save Buffer" . save-buffer)
- ("Kill Buffer" . kill-buffer)
- ("Select Buffer" . switch-to-buffer))))))
- (if (eq action 'save-buffer)
- (save-excursion
- (set-buffer buf)
- (save-buffer))
- (funcall action buf)))
- (and (windowp window)
- (select-window window))
- (switch-to-buffer buf)))))))
+ ;; Put into each element of buffer-list
+ ;; the name for actual display,
+ ;; perhaps truncated in the middle.
+ (setq tail buffer-list)
+ (while tail
+ (let ((name (buffer-name (car (car tail)))))
+ (setcdr (car tail)
+ (if (> (length name) 27)
+ (concat (substring name 0 12)
+ "..."
+ (substring name -12))
+ name)))
+ (setq tail (cdr tail)))
+ ;; Compute the maximum length of any name.
+ (setq tail buffer-list)
+ (while tail
+ (or (eq ?\ (aref (cdr (car tail)) 0))
+ (setq menu-bar-update-buffers-maxbuf
+ (max menu-bar-update-buffers-maxbuf
+ (length (cdr (car tail))))))
+ (setq tail (cdr tail)))
+ ;; Set ALIST to an alist of the form
+ ;; ITEM-STRING . BUFFER
+ (setq tail buffer-list)
+ (while tail
+ (let ((elt (car tail)))
+ (or (eq ?\ (aref (cdr elt) 0))
+ (setq alist (cons
+ (menu-bar-update-buffers-1 elt)
+ alist)))
+ (and alist (> (length (car (car alist))) maxlen)
+ (setq maxlen (length (car (car alist))))))
+ (setq tail (cdr tail)))
+ (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)))))
+
+
+ ;; Make a Frames menu if we have more than one frame.
+ (if (cdr frames)
+ (setq frames-menu
+ (cons "Select Frame"
+ (mapcar '(lambda (frame)
+ (nconc (list frame
+ (cdr (assq 'name
+ (frame-parameters frame)))
+ (cons nil nil))
+ 'menu-bar-select-frame))
+ frames))))
+ (if buffers-menu
+ (setq buffers-menu (cons 'keymap buffers-menu)))
+ (if frames-menu
+ (setq frames-menu (cons 'keymap frames-menu)))
+ (define-key (current-global-map) [menu-bar buffer]
+ (cons "Buffers"
+ (if (and buffers-menu frames-menu)
+ (list 'keymap "Buffers and Frames"
+ (cons 'buffers (cons "Buffers" buffers-menu))
+ (cons 'frames (cons "Frames" frames-menu)))
+ (or buffers-menu frames-menu 'undefined)))))))
+
+(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
+
+(menu-bar-update-buffers)