- (let ((buffers (buffer-list))
- (frames (frame-list))
- buffers-menu frames-menu)
- (if (and (equal buffers menu-bar-update-buffers-last-buffers)
- (equal frames menu-bar-update-buffers-last-frames))
- nil
- (setq menu-bar-update-buffers-last-buffers buffers)
- (setq menu-bar-update-buffers-last-frames frames)
- ;; If requested, list only the N most recently selected buffers.
- (if (and (integerp buffers-menu-max-size)
- (> buffers-menu-max-size 1))
- (if (> (length buffers) buffers-menu-max-size)
- (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
-
- ;; Make the menu of buffers proper.
- (setq buffers-menu
- (cons "Select Buffer"
- (let ((tail buffers)
- (maxbuf 0)
- (maxlen 0)
- alist
- head)
- (while tail
- (or (eq ?\ (aref (buffer-name (car tail)) 0))
- (setq maxbuf
- (max maxbuf
- (length (buffer-name (car tail))))))
- (setq tail (cdr tail)))
- (setq tail buffers)
- (while tail
- (let ((elt (car tail)))
- (or (eq ?\ (aref (buffer-name elt) 0))
- (setq alist (cons
- (cons
- (format
- (format "%%%ds %%s%%s %%s"
- maxbuf)
- (buffer-name elt)
- (if (buffer-modified-p elt)
- "*" " ")
- (save-excursion
- (set-buffer elt)
- (if buffer-read-only "%" " "))
- (or (buffer-file-name elt)
- (save-excursion
- (set-buffer elt)
- list-buffers-directory)
- ""))
- elt)
- alist)))
- (and alist (> (length (car (car alist))) maxlen)
- (setq maxlen (length (car (car alist))))))
- (setq tail (cdr tail)))
- (setq alist (nreverse alist))
- (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 (cons 'list-buffers
- (cons
- (concat (make-string (max (- (/ maxlen
- 2)
- 8)
- 0) ?\ )
- "List All Buffers")
- 'list-buffers)))))))
-
-
- ;; 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 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)))))))
+ ;; If user discards the Buffers item, play along.
+ (and (lookup-key (current-global-map) [menu-bar buffer])
+ (frame-or-buffer-changed-p)
+ (let ((buffers (buffer-list))
+ (frames (frame-list))
+ (maxlen 0)
+ buffers-menu frames-menu)
+ ;; If requested, list only the N most recently selected buffers.
+ (if (and (integerp buffers-menu-max-size)
+ (> buffers-menu-max-size 1))
+ (if (> (length buffers) buffers-menu-max-size)
+ (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
+
+ ;; Make the menu of buffers proper.
+ (setq buffers-menu
+ (cons "Select Buffer"
+ (let* ((buffer-list
+ (mapcar 'list buffers))
+ tail
+ (menu-bar-update-buffers-maxbuf 0)
+ alist
+ head)
+ ;; 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)
+ (let ((name (concat (make-string (max (- (/ maxlen 2) 3) 0)
+ ?\ )
+ "Frames"))
+ (frames-menu
+ (cons 'keymap
+ (cons "Select Frame"
+ (mapcar '(lambda (frame)
+ (nconc (list frame
+ (cdr (assq 'name
+ (frame-parameters frame)))
+ (cons nil nil))
+ 'menu-bar-select-frame))
+ frames)))))
+ ;; Put it underneath the Buffers menu.
+ (setq buffers-menu (cons (cons 'frames (cons name frames-menu))
+ buffers-menu))))
+ (if buffers-menu
+ (setq buffers-menu (cons 'keymap buffers-menu)))
+ (define-key (current-global-map) [menu-bar buffer]
+ (cons "Buffers" buffers-menu)))))