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