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