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