(describe-prefix-bindings): If key is a string,
[bpt/emacs.git] / lisp / menu-bar.el
CommitLineData
235aa29b
ER
1;;; menu-bar.el --- define a default menu bar.
2
3;; Author: RMS
b7f66977 4;; Keywords: internal
235aa29b 5
f8c25f1b 6;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
1db87953
RS
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to
22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
235aa29b 24;;; Code:
1db87953 25
b132f2b1
RM
26;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
27;; definitions made in loaddefs.el.
28(or (lookup-key global-map [menu-bar])
29 (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
22390f50 30(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
ffbdd83d
RS
31
32;; Force Help item to come last, after the major mode's own items.
da183f87 33(setq menu-bar-final-items '(help))
ffbdd83d 34
da183f87 35(define-key global-map [menu-bar help] (cons "Help" menu-bar-help-menu))
ffbdd83d
RS
36(defvar menu-bar-search-menu (make-sparse-keymap "Search"))
37(define-key global-map [menu-bar search] (cons "Search" menu-bar-search-menu))
22390f50 38(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
40954111 39(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
ffbdd83d
RS
40(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
41(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
42(defvar menu-bar-files-menu (make-sparse-keymap "Files"))
43(define-key global-map [menu-bar files] (cons "Files" menu-bar-files-menu))
1b009b97
RS
44
45;; This alias is for compatibility with 19.28 and before.
46(defvar menu-bar-file-menu menu-bar-files-menu)
9bb8e471 47\f
9dcdc43d
RS
48(defvar vc-menu-map (make-sparse-keymap "Version Control"))
49
e1726722 50(define-key menu-bar-tools-menu [calendar] '("Display Calendar" . calendar))
ffbdd83d
RS
51(define-key menu-bar-tools-menu [rmail] '("Read Mail" . rmail))
52(define-key menu-bar-tools-menu [gnus] '("Read Net News" . gnus))
53
54(define-key menu-bar-tools-menu [separator-vc]
55 '("--"))
56
57(define-key menu-bar-tools-menu [vc-menu]
58 (cons "Version Control" vc-menu-map))
9bb8e471 59
ffbdd83d 60(define-key menu-bar-tools-menu [separator-compare]
9bb8e471
RS
61 '("--"))
62
ffbdd83d 63(define-key menu-bar-tools-menu [epatch]
080ac1ac 64 '("Apply Patch" . menu-bar-epatch-menu))
ffbdd83d 65(define-key menu-bar-tools-menu [ediff-merge]
5438ecd3 66 '("Merge" . menu-bar-ediff-merge-menu))
57eed34a 67(define-key menu-bar-tools-menu [compare]
40a8cde1 68 '("Compare" . menu-bar-ediff-menu))
9bb8e471 69
ffbdd83d 70(define-key menu-bar-tools-menu [separator-print]
9bb8e471
RS
71 '("--"))
72
ffbdd83d
RS
73(put 'print-region 'menu-enable 'mark-active)
74(put 'ps-print-region-with-faces 'menu-enable 'mark-active)
75
76(define-key menu-bar-tools-menu [ps-print-region]
77 '("Postscript Print Region" . ps-print-region-with-faces))
78(define-key menu-bar-tools-menu [ps-print-buffer]
79 '("Postscript Print Buffer" . ps-print-buffer-with-faces))
80(define-key menu-bar-tools-menu [print-region]
81 '("Print Region" . print-region))
82(define-key menu-bar-tools-menu [print-buffer]
83 '("Print Buffer" . print-buffer))
84\f
85(define-key menu-bar-files-menu [exit-emacs]
86 '("Exit Emacs" . save-buffers-kill-emacs))
87
88(define-key menu-bar-files-menu [separator-exit]
89 '("--"))
90
91(define-key menu-bar-files-menu [one-window]
92 '("One Window" . delete-other-windows))
93
94(define-key menu-bar-files-menu [split-window]
95 '("Split Window" . split-window-vertically))
9bb8e471 96
ca1a9692
RS
97(if (fboundp 'delete-frame)
98 (progn
ffbdd83d 99 (define-key menu-bar-files-menu [delete-frame]
ca1a9692 100 '("Delete Frame" . delete-frame))
ffbdd83d
RS
101 (define-key menu-bar-files-menu [make-frame-on-display]
102 '("Open New Display..." . make-frame-on-display))
103 (define-key menu-bar-files-menu [make-frame]
ca1a9692 104 '("Make New Frame" . make-frame))))
9bb8e471 105
ffbdd83d 106(define-key menu-bar-files-menu [separator-buffers]
9bb8e471
RS
107 '("--"))
108
ffbdd83d
RS
109(define-key menu-bar-files-menu [kill-buffer]
110 '("Kill Current Buffer" . kill-this-buffer))
111(define-key menu-bar-files-menu [insert-file]
1f50590a 112 '("Insert File..." . insert-file))
ffbdd83d 113(define-key menu-bar-files-menu [revert-buffer]
2f1139a4 114 '("Revert Buffer" . revert-buffer))
ffbdd83d 115(define-key menu-bar-files-menu [write-file]
2f1139a4 116 '("Save Buffer As..." . write-file))
ffbdd83d
RS
117(define-key menu-bar-files-menu [save-buffer] '("Save Buffer" . save-buffer))
118(define-key menu-bar-files-menu [dired] '("Open Directory..." . dired))
119(define-key menu-bar-files-menu [open-file] '("Open File..." . find-file))
40a8cde1
RS
120
121;; This is just one element of the ediff menu--the first.
122(define-key menu-bar-ediff-menu [window]
123 '("This Window And Next Window" . compare-windows))
9bb8e471 124\f
ffbdd83d
RS
125(defun nonincremental-search-forward (string)
126 "Read a string and search for it nonincrementally."
127 (interactive "sSearch for string: ")
128 (if (equal string "")
129 (search-forward (car search-ring))
130 (isearch-update-ring string nil)
131 (search-forward string)))
132
133(defun nonincremental-search-backward (string)
134 "Read a string and search backward for it nonincrementally."
135 (interactive "sSearch for string: ")
136 (if (equal string "")
137 (search-backward (car search-ring))
138 (isearch-update-ring string nil)
139 (search-backward string)))
140
141(defun nonincremental-re-search-forward (string)
142 "Read a regular expression and search for it nonincrementally."
143 (interactive "sSearch for regexp: ")
144 (if (equal string "")
145 (re-search-forward (car regexp-search-ring))
146 (isearch-update-ring string t)
147 (re-search-forward string)))
148
149(defun nonincremental-re-search-backward (string)
150 "Read a regular expression and search backward for it nonincrementally."
151 (interactive "sSearch for regexp: ")
152 (if (equal string "")
153 (re-search-backward (car regexp-search-ring))
154 (isearch-update-ring string t)
155 (re-search-backward string)))
156
1f50590a 157(defun nonincremental-repeat-search-forward ()
ffbdd83d
RS
158 "Search forward for the previous search string."
159 (interactive)
160 (search-forward (car search-ring)))
161
1f50590a 162(defun nonincremental-repeat-search-backward ()
ffbdd83d
RS
163 "Search backward for the previous search string."
164 (interactive)
165 (search-backward (car search-ring)))
166
1f50590a 167(defun nonincremental-repeat-re-search-forward ()
ffbdd83d
RS
168 "Search forward for the previous regular expression."
169 (interactive)
170 (re-search-forward (car regexp-search-ring)))
171
1f50590a 172(defun nonincremental-repeat-re-search-backward ()
ffbdd83d
RS
173 "Search backward for the previous regular expression."
174 (interactive)
175 (re-search-backward (car regexp-search-ring)))
176
1f50590a
RS
177(define-key menu-bar-search-menu [query-replace-regexp]
178 '("Query Replace Regexp..." . query-replace-regexp))
ffbdd83d 179(define-key menu-bar-search-menu [query-replace]
1f50590a 180 '("Query Replace..." . query-replace))
ffbdd83d 181(define-key menu-bar-search-menu [find-tag]
1f50590a 182 '("Find Tag..." . find-tag))
ffbdd83d
RS
183(put 'find-tag 'menu-enable 'tags-table-list)
184(define-key menu-bar-search-menu [bookmark]
185 '("Bookmarks" . menu-bar-bookmark-map))
186
187(define-key menu-bar-search-menu [separator-search]
188 '("--"))
189
190(define-key menu-bar-search-menu [nonincremental-repeat-re-search-back]
191 '("Repeat Regexp Backwards" . nonincremental-repeat-re-search-backward))
192(define-key menu-bar-search-menu [nonincremental-repeat-search-back]
193 '("Repeat Backwards" . nonincremental-repeat-search-backward))
194(define-key menu-bar-search-menu [nonincremental-repeat-re-search-fwd]
195 '("Repeat Regexp" . nonincremental-repeat-re-search-forward))
196(define-key menu-bar-search-menu [nonincremental-repeat-search-fwd]
197 '("Repeat Search" . nonincremental-repeat-search-forward))
198
199(define-key menu-bar-search-menu [separator-repeat]
9bb8e471
RS
200 '("--"))
201
ffbdd83d 202(define-key menu-bar-search-menu [re-search-back]
1f50590a 203 '("Regexp Search Backwards..." . nonincremental-re-search-backward))
ffbdd83d 204(define-key menu-bar-search-menu [search-back]
1f50590a 205 '("Search Backwards..." . nonincremental-search-backward))
ffbdd83d 206(define-key menu-bar-search-menu [re-search-fwd]
1f50590a 207 '("Regexp Search..." . nonincremental-re-search-forward))
ffbdd83d 208(define-key menu-bar-search-menu [search-fwd]
1f50590a 209 '("Search..." . nonincremental-search-forward))
ffbdd83d 210\f
5b42ec2b
RS
211(if (fboundp 'start-process)
212 (define-key menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map)))
9bb8e471 213(define-key menu-bar-edit-menu [fill] '("Fill" . fill-region))
6507ffb1 214(define-key menu-bar-edit-menu [props] '("Text Properties" . facemenu-menu))
9bb8e471
RS
215
216(define-key menu-bar-edit-menu [separator-edit]
217 '("--"))
218
219(define-key menu-bar-edit-menu [clear] '("Clear" . delete-region))
3dd92899 220
e1726722 221(define-key menu-bar-edit-menu [paste] '("Paste Most Recent" . yank))
3dd92899
KH
222
223(defvar yank-menu (cons "Select Yank" nil))
224(fset 'yank-menu (cons 'keymap yank-menu))
225(define-key menu-bar-edit-menu [select-paste] '("Select and Paste" . yank-menu))
4c0317b1 226(define-key menu-bar-edit-menu [copy] '("Copy" . menu-bar-kill-ring-save))
057d49d1
RS
227(define-key menu-bar-edit-menu [cut] '("Cut" . kill-region))
228(define-key menu-bar-edit-menu [undo] '("Undo" . undo))
229
4c0317b1
RS
230(defun menu-bar-kill-ring-save (beg end)
231 (interactive "r")
232 (if (mouse-region-match)
233 (message "Select a region with the mouse does `copy' automatically")
234 (kill-ring-save beg end)))
235
057d49d1
RS
236(put 'fill-region 'menu-enable 'mark-active)
237(put 'kill-region 'menu-enable 'mark-active)
4c0317b1 238(put 'menu-bar-kill-ring-save 'menu-enable 'mark-active)
057d49d1 239(put 'yank 'menu-enable '(x-selection-exists-p))
3dd92899 240(put 'yank-menu 'menu-enable '(cdr yank-menu))
4c0317b1
RS
241(put 'delete-region 'menu-enable '(and mark-active
242 (not (mouse-region-match))))
057d49d1
RS
243(put 'undo 'menu-enable '(if (eq last-command 'undo)
244 pending-undo-list
245 (consp buffer-undo-list)))
3a841b0b 246(put 'query-replace 'menu-enable '(not buffer-read-only))
db774a16 247
9e18f0a0
RS
248(autoload 'ispell-menu-map "ispell" nil t 'keymap)
249
f9cf0be2 250;; These are alternative definitions for the cut, paste and copy
4c0317b1 251;; menu items. Use them if your system expects these to use the clipboard.
f9cf0be2 252
f9cf0be2
RS
253(put 'clipboard-kill-region 'menu-enable 'mark-active)
254(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
255(put 'clipboard-yank 'menu-enable
256 '(or (x-selection-exists-p) (x-selection-exists-p 'CLIPBOARD)))
257
258(defun clipboard-yank ()
259 "Reinsert the last stretch of killed text, or the clipboard contents."
260 (interactive)
261 (let ((x-select-enable-clipboard t))
262 (yank)))
263
264(defun clipboard-kill-ring-save (beg end)
265 "Copy region to kill ring, and save in the X clipboard."
266 (interactive "r")
267 (let ((x-select-enable-clipboard t))
268 (kill-ring-save beg end)))
269
270(defun clipboard-kill-region (beg end)
271 "Kill the region, and save it in the X clipboard."
272 (interactive "r")
273 (let ((x-select-enable-clipboard t))
274 (kill-region beg end)))
275
276(defun menu-bar-enable-clipboard ()
5cbdeb30
RS
277 "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
278Do the same for the keys of the same name."
f9cf0be2 279 (interactive)
5754d7f2
RS
280 ;; We can't use constant list structure here because it becomes pure,
281 ;; and because it gets modified with cache data.
282 (define-key menu-bar-edit-menu [paste]
283 (cons "Paste" 'clipboard-yank))
284 (define-key menu-bar-edit-menu [copy]
285 (cons "Copy" 'clipboard-kill-ring-save))
286 (define-key menu-bar-edit-menu [cut]
5cbdeb30
RS
287 (cons "Cut" 'clipboard-kill-region))
288
289 (define-key global-map [f20] 'clipboard-kill-region)
290 (define-key global-map [f16] 'clipboard-kill-ring-save)
291 (define-key global-map [f18] 'clipboard-yank)
292 ;; X11R6 versions
293 (define-key global-map [cut] 'clipboard-kill-region)
294 (define-key global-map [copy] 'clipboard-kill-ring-save)
295 (define-key global-map [paste] 'clipboard-yank))
f9cf0be2 296\f
efb166ff
RS
297(define-key menu-bar-help-menu [emacs-version]
298 '("Show Version" . emacs-version))
48433a65
RS
299(define-key menu-bar-help-menu [report-emacs-bug]
300 '("Send Bug Report" . report-emacs-bug))
ca9b40a1 301(define-key menu-bar-help-menu [emacs-tutorial]
db774a16 302 '("Emacs Tutorial" . help-with-tutorial))
2f1139a4
RS
303(define-key menu-bar-help-menu [man] '("Man..." . manual-entry))
304(define-key menu-bar-help-menu [describe-variable]
305 '("Describe Variable..." . describe-variable))
306(define-key menu-bar-help-menu [describe-function]
307 '("Describe Function..." . describe-function))
308(define-key menu-bar-help-menu [describe-key]
309 '("Describe Key..." . describe-key))
310(define-key menu-bar-help-menu [list-keybindings]
311 '("List Keybindings" . describe-bindings))
312(define-key menu-bar-help-menu [command-apropos]
313 '("Command Apropos..." . command-apropos))
314(define-key menu-bar-help-menu [describe-mode]
315 '("Describe Mode" . describe-mode))
e1726722 316(define-key menu-bar-help-menu [info] '("Browse Manuals" . info))
889560ed 317(define-key menu-bar-help-menu [emacs-faq] '("Emacs FAQ" . view-emacs-FAQ))
2f1139a4 318(define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news))
889560ed 319
db774a16
RS
320(defun kill-this-buffer () ; for the menubar
321 "Kills the current buffer."
322 (interactive)
323 (kill-buffer (current-buffer)))
324
2f1139a4
RS
325(defun kill-this-buffer-enabled-p ()
326 (let ((count 0)
327 (buffers (buffer-list)))
328 (while buffers
329 (or (string-match "^ " (buffer-name (car buffers)))
330 (setq count (1+ count)))
331 (setq buffers (cdr buffers)))
1f50590a
RS
332 (and (not (window-minibuffer-p (selected-window)))
333 (> count 1))))
334
335(put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p))
336
337(put 'save-buffer 'menu-enable
338 '(and (buffer-modified-p)
339 (not (window-minibuffer-p (selected-window)))))
340
341(put 'write-file 'menu-enable
342 '(not (window-minibuffer-p (selected-window))))
343
344(put 'find-file 'menu-enable
345 '(not (window-minibuffer-p (selected-window))))
346
347(put 'dired 'menu-enable
348 '(not (window-minibuffer-p (selected-window))))
349
350(put 'insert-file 'menu-enable
351 '(not (window-minibuffer-p (selected-window))))
2f1139a4 352
da183f87
RS
353(put 'revert-buffer 'menu-enable
354 '(or revert-buffer-function revert-buffer-insert-file-contents-function
355 (and (buffer-file-name)
660fa562
RM
356 (or (buffer-modified-p)
357 (not (verify-visited-file-modtime (current-buffer)))))))
a0213a97
RS
358;; Permit deleting frame if it would leave a visible or iconified frame.
359(put 'delete-frame 'menu-enable
360 '(let ((frames (frame-list))
361 (count 0))
362 (while frames
363 (if (cdr (assq 'visibility (frame-parameters (car frames))))
364 (setq count (1+ count)))
365 (setq frames (cdr frames)))
366 (> count 1)))
2f1139a4 367
db774a16
RS
368(put 'advertised-undo 'menu-enable
369 '(and (not (eq t buffer-undo-list))
370 (if (eq last-command 'undo)
2f1139a4
RS
371 (and (boundp 'pending-undo-list)
372 pending-undo-list)
373 buffer-undo-list)))
2877eac2 374
c3e1d435 375(defvar yank-menu-length 20
3dd92899
KH
376 "*Maximum length to display in the yank-menu.")
377
378(defun menu-bar-update-yank-menu (string old)
379 (let ((front (car (cdr yank-menu)))
380 (menu-string (if (<= (length string) yank-menu-length)
381 string
c3e1d435
RS
382 (concat
383 (substring string 0 (/ yank-menu-length 2))
384 "..."
385 (substring string (- (/ yank-menu-length 2)))))))
3dd92899
KH
386 ;; If we're supposed to be extending an existing string, and that
387 ;; string really is at the front of the menu, then update it in place.
388 (if (and old (or (eq old (car front))
389 (string= old (car front))))
dfabc98f 390 (progn
3dd92899
KH
391 (setcar front string)
392 (setcar (cdr front) menu-string))
393 (setcdr yank-menu
394 (cons
395 (cons string (cons menu-string 'menu-bar-select-yank))
396 (cdr yank-menu)))))
397 (if (> (length (cdr yank-menu)) kill-ring-max)
398 (setcdr (nthcdr kill-ring-max yank-menu) nil)))
399
400(defun menu-bar-select-yank ()
401 (interactive "*")
402 (push-mark (point))
403 (insert last-command-event))
40954111 404\f
09642d97
RS
405(define-key global-map [menu-bar buffer] '("Buffers" . menu-bar-buffers))
406
407(defalias 'menu-bar-buffers (make-sparse-keymap "Buffers"))
40954111 408
40954111
RS
409(defvar buffers-menu-max-size 10
410 "*Maximum number of entries which may appear on the Buffers menu.
411If this is 10, then only the ten most-recently-selected buffers are shown.
412If this is nil, then all buffers are shown.
413A large number or nil slows down menu responsiveness.")
414
d0690d12
RS
415(defvar list-buffers-directory nil)
416
08e8171f
RS
417(defvar menu-bar-update-buffers-maxbuf)
418
09642d97
RS
419(defun menu-bar-select-buffer ()
420 (interactive)
421 (switch-to-buffer last-command-event))
422
423(defun menu-bar-select-frame ()
424 (interactive)
425 (make-frame-visible last-command-event)
426 (raise-frame last-command-event)
427 (select-frame last-command-event))
428
c171b42f
RS
429(defun menu-bar-update-buffers-1 (elt)
430 (cons (format
08e8171f 431 (format "%%%ds %%s%%s %%s" menu-bar-update-buffers-maxbuf)
c171b42f
RS
432 (cdr elt)
433 (if (buffer-modified-p (car elt))
434 "*" " ")
435 (save-excursion
436 (set-buffer (car elt))
437 (if buffer-read-only "%" " "))
438 (let ((file
439 (or (buffer-file-name (car elt))
440 (save-excursion
441 (set-buffer (car elt))
442 list-buffers-directory)
443 "")))
444 (setq file (or (file-name-directory file)
445 ""))
446 (if (> (length file) 20)
447 (setq file (concat "..." (substring file -17))))
448 file))
449 (car elt)))
450
06ff7539
RS
451(defvar menu-bar-buffers-menu-list-buffers-entry nil)
452
09642d97 453(defun menu-bar-update-buffers ()
29397c58 454 ;; If user discards the Buffers item, play along.
4d587a6c 455 (and (lookup-key (current-global-map) [menu-bar buffer])
29397c58
RS
456 (frame-or-buffer-changed-p)
457 (let ((buffers (buffer-list))
458 (frames (frame-list))
459 buffers-menu frames-menu)
460 ;; If requested, list only the N most recently selected buffers.
461 (if (and (integerp buffers-menu-max-size)
462 (> buffers-menu-max-size 1))
463 (if (> (length buffers) buffers-menu-max-size)
464 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
465
466 ;; Make the menu of buffers proper.
467 (setq buffers-menu
468 (cons "Select Buffer"
c171b42f
RS
469 (let* ((buffer-list
470 (mapcar 'list buffers))
471 tail
08e8171f 472 (menu-bar-update-buffers-maxbuf 0)
c171b42f
RS
473 (maxlen 0)
474 alist
475 head)
476 ;; Put into each element of buffer-list
477 ;; the name for actual display,
478 ;; perhaps truncated in the middle.
479 (setq tail buffer-list)
480 (while tail
481 (let ((name (buffer-name (car (car tail)))))
482 (setcdr (car tail)
483 (if (> (length name) 27)
484 (concat (substring name 0 12)
485 "..."
486 (substring name -12))
487 name)))
488 (setq tail (cdr tail)))
489 ;; Compute the maximum length of any name.
490 (setq tail buffer-list)
29397c58 491 (while tail
c171b42f 492 (or (eq ?\ (aref (cdr (car tail)) 0))
08e8171f
RS
493 (setq menu-bar-update-buffers-maxbuf
494 (max menu-bar-update-buffers-maxbuf
c171b42f 495 (length (cdr (car tail))))))
29397c58 496 (setq tail (cdr tail)))
c171b42f
RS
497 ;; Set ALIST to an alist of the form
498 ;; ITEM-STRING . BUFFER
499 (setq tail buffer-list)
29397c58
RS
500 (while tail
501 (let ((elt (car tail)))
c171b42f 502 (or (eq ?\ (aref (cdr elt) 0))
29397c58 503 (setq alist (cons
c171b42f 504 (menu-bar-update-buffers-1 elt)
29397c58
RS
505 alist)))
506 (and alist (> (length (car (car alist))) maxlen)
507 (setq maxlen (length (car (car alist))))))
508 (setq tail (cdr tail)))
509 (setq alist (nreverse alist))
06ff7539
RS
510 ;; Make the menu item for list-buffers
511 ;; or reuse the one we already have.
512 ;; The advantage in reusing one
513 ;; is that it already has the keyboard equivalent
514 ;; cached, so we save the time to look that up again.
515 (or menu-bar-buffers-menu-list-buffers-entry
516 (setq menu-bar-buffers-menu-list-buffers-entry
517 (cons
518 'list-buffers
519 (cons
520 ""
521 'list-buffers))))
522 ;; Update the item string for menu's new width.
523 (setcar (cdr menu-bar-buffers-menu-list-buffers-entry)
524 (concat (make-string (max (- (/ maxlen 2) 8) 0)
525 ?\ )
526 "List All Buffers"))
527 ;; Now make the actual list of items,
528 ;; ending with the list-buffers item.
29397c58
RS
529 (nconc (mapcar '(lambda (pair)
530 ;; This is somewhat risque, to use
531 ;; the buffer name itself as the event
532 ;; type to define, but it works.
533 ;; It would not work to use the buffer
534 ;; since a buffer as an event has its
535 ;; own meaning.
536 (nconc (list (buffer-name (cdr pair))
537 (car pair)
538 (cons nil nil))
539 'menu-bar-select-buffer))
540 alist)
06ff7539 541 (list menu-bar-buffers-menu-list-buffers-entry)))))
29397c58
RS
542
543
544 ;; Make a Frames menu if we have more than one frame.
545 (if (cdr frames)
546 (setq frames-menu
547 (cons "Select Frame"
548 (mapcar '(lambda (frame)
549 (nconc (list frame
550 (cdr (assq 'name
551 (frame-parameters frame)))
552 (cons nil nil))
553 'menu-bar-select-frame))
554 frames))))
555 (if buffers-menu
556 (setq buffers-menu (cons 'keymap buffers-menu)))
557 (if frames-menu
558 (setq frames-menu (cons 'keymap frames-menu)))
4d587a6c 559 (define-key (current-global-map) [menu-bar buffer]
29397c58
RS
560 (cons "Buffers"
561 (if (and buffers-menu frames-menu)
562 (list 'keymap "Buffers and Frames"
563 (cons 'buffers (cons "Buffers" buffers-menu))
564 (cons 'frames (cons "Frames" frames-menu)))
565 (or buffers-menu frames-menu 'undefined)))))))
09642d97
RS
566
567(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
2f1139a4 568
40954111
RS
569;; this version is too slow
570;;;(defun format-buffers-menu-line (buffer)
571;;; "Returns a string to represent the given buffer in the Buffer menu.
572;;;nil means the buffer shouldn't be listed. You can redefine this."
573;;; (if (string-match "\\` " (buffer-name buffer))
574;;; nil
575;;; (save-excursion
576;;; (set-buffer buffer)
577;;; (let ((size (buffer-size)))
578;;; (format "%s%s %-19s %6s %-15s %s"
579;;; (if (buffer-modified-p) "*" " ")
580;;; (if buffer-read-only "%" " ")
581;;; (buffer-name)
582;;; size
583;;; mode-name
584;;; (or (buffer-file-name) ""))))))
585\f
7b7d6615
RS
586(defvar menu-bar-mode nil)
587
057d49d1 588(defun menu-bar-mode (flag)
dfd29450 589 "Toggle display of a menu bar on each frame.
057d49d1
RS
590This command applies to all frames that exist and frames to be
591created in the future.
592With a numeric argument, if the argument is negative,
dfd29450 593turn off menu bars; otherwise, turn on menu bars."
dad8e392 594 (interactive "P")
dad8e392 595
7b7d6615
RS
596 ;; Make menu-bar-mode and default-frame-alist consistent.
597 (let ((default (assq 'menu-bar-lines default-frame-alist)))
598 (if default
599 (setq menu-bar-mode (not (eq (cdr default) 0)))
600 (setq default-frame-alist
601 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
602 default-frame-alist))))
603
604 ;; Toggle or set the mode, according to FLAG.
605 (setq menu-bar-mode (if (null flag) (not menu-bar-mode)
606 (> (prefix-numeric-value flag) 0)))
607
608 ;; Apply it to default-frame-alist.
609 (let ((parameter (assq 'menu-bar-lines default-frame-alist)))
610 (if (consp parameter)
611 (setcdr parameter (if menu-bar-mode 1 0))
612 (setq default-frame-alist
613 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
614 default-frame-alist))))
615
616 ;; Apply it to existing frames.
617 (let ((frames (frame-list)))
618 (while frames
619 (let ((height (cdr (assq 'height (frame-parameters (car frames))))))
620 (modify-frame-parameters (car frames)
621 (list (cons 'menu-bar-lines
622 (if menu-bar-mode 1 0))))
623 (modify-frame-parameters (car frames)
624 (list (cons 'height height))))
625 (setq frames (cdr frames)))))
1db87953 626
bffa5d4d
RS
627(provide 'menu-bar)
628
235aa29b 629;;; menu-bar.el ends here