(byte-compile-associative): Do operations left to right.
[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 125
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))
260130bb
KH
305(define-key menu-bar-help-menu [finder-by-keyword]
306 '("Find Lisp Packages..." . finder-by-keyword))
ca9b40a1 307(define-key menu-bar-help-menu [emacs-tutorial]
db774a16 308 '("Emacs Tutorial" . help-with-tutorial))
260130bb
KH
309(define-key menu-bar-help-menu [man]
310 '("Man..." . manual-entry))
2f1139a4
RS
311(define-key menu-bar-help-menu [describe-variable]
312 '("Describe Variable..." . describe-variable))
313(define-key menu-bar-help-menu [describe-function]
314 '("Describe Function..." . describe-function))
315(define-key menu-bar-help-menu [describe-key]
316 '("Describe Key..." . describe-key))
317(define-key menu-bar-help-menu [list-keybindings]
318 '("List Keybindings" . describe-bindings))
319(define-key menu-bar-help-menu [command-apropos]
320 '("Command Apropos..." . command-apropos))
321(define-key menu-bar-help-menu [describe-mode]
322 '("Describe Mode" . describe-mode))
e1726722 323(define-key menu-bar-help-menu [info] '("Browse Manuals" . info))
889560ed 324(define-key menu-bar-help-menu [emacs-faq] '("Emacs FAQ" . view-emacs-FAQ))
2f1139a4 325(define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news))
889560ed 326
db774a16
RS
327(defun kill-this-buffer () ; for the menubar
328 "Kills the current buffer."
329 (interactive)
330 (kill-buffer (current-buffer)))
331
2f1139a4
RS
332(defun kill-this-buffer-enabled-p ()
333 (let ((count 0)
334 (buffers (buffer-list)))
335 (while buffers
336 (or (string-match "^ " (buffer-name (car buffers)))
337 (setq count (1+ count)))
338 (setq buffers (cdr buffers)))
1f50590a
RS
339 (and (not (window-minibuffer-p (selected-window)))
340 (> count 1))))
341
342(put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p))
343
344(put 'save-buffer 'menu-enable
345 '(and (buffer-modified-p)
346 (not (window-minibuffer-p (selected-window)))))
347
348(put 'write-file 'menu-enable
349 '(not (window-minibuffer-p (selected-window))))
350
351(put 'find-file 'menu-enable
352 '(not (window-minibuffer-p (selected-window))))
353
354(put 'dired 'menu-enable
355 '(not (window-minibuffer-p (selected-window))))
356
357(put 'insert-file 'menu-enable
358 '(not (window-minibuffer-p (selected-window))))
2f1139a4 359
da183f87
RS
360(put 'revert-buffer 'menu-enable
361 '(or revert-buffer-function revert-buffer-insert-file-contents-function
362 (and (buffer-file-name)
660fa562
RM
363 (or (buffer-modified-p)
364 (not (verify-visited-file-modtime (current-buffer)))))))
82a74107 365
a0213a97
RS
366;; Permit deleting frame if it would leave a visible or iconified frame.
367(put 'delete-frame 'menu-enable
82a74107
KH
368 '(delete-frame-enabled-p))
369
370(defun delete-frame-enabled-p ()
371 "Return non-nil if `delete-frame' should be enabled in the menu bar."
372 (let ((frames (frame-list))
373 (count 0))
374 (while frames
375 (if (frame-visible-p (car frames))
376 (setq count (1+ count)))
377 (setq frames (cdr frames)))
378 (> count 1)))
2f1139a4 379
db774a16
RS
380(put 'advertised-undo 'menu-enable
381 '(and (not (eq t buffer-undo-list))
382 (if (eq last-command 'undo)
2f1139a4
RS
383 (and (boundp 'pending-undo-list)
384 pending-undo-list)
385 buffer-undo-list)))
2877eac2 386
c3e1d435 387(defvar yank-menu-length 20
3dd92899
KH
388 "*Maximum length to display in the yank-menu.")
389
390(defun menu-bar-update-yank-menu (string old)
391 (let ((front (car (cdr yank-menu)))
392 (menu-string (if (<= (length string) yank-menu-length)
393 string
c3e1d435
RS
394 (concat
395 (substring string 0 (/ yank-menu-length 2))
396 "..."
397 (substring string (- (/ yank-menu-length 2)))))))
7c70a955
RS
398 ;; Don't let the menu string be all dashes
399 ;; because that has a special meaning in a menu.
400 (if (string-match "\\`-+\\'" menu-string)
401 (setq menu-string (concat menu-string " ")))
3dd92899
KH
402 ;; If we're supposed to be extending an existing string, and that
403 ;; string really is at the front of the menu, then update it in place.
404 (if (and old (or (eq old (car front))
405 (string= old (car front))))
dfabc98f 406 (progn
3dd92899
KH
407 (setcar front string)
408 (setcar (cdr front) menu-string))
409 (setcdr yank-menu
410 (cons
411 (cons string (cons menu-string 'menu-bar-select-yank))
412 (cdr yank-menu)))))
413 (if (> (length (cdr yank-menu)) kill-ring-max)
414 (setcdr (nthcdr kill-ring-max yank-menu) nil)))
415
416(defun menu-bar-select-yank ()
417 (interactive "*")
418 (push-mark (point))
419 (insert last-command-event))
40954111 420\f
3f557298
RS
421;; This definition is just to show what this looks like.
422;; It gets overridden below when menu-bar-update-buffers is called.
423(define-key global-map [menu-bar buffer]
424 (cons "Buffers" (make-sparse-keymap "Buffers")))
40954111 425
40954111
RS
426(defvar buffers-menu-max-size 10
427 "*Maximum number of entries which may appear on the Buffers menu.
428If this is 10, then only the ten most-recently-selected buffers are shown.
429If this is nil, then all buffers are shown.
430A large number or nil slows down menu responsiveness.")
431
d0690d12
RS
432(defvar list-buffers-directory nil)
433
08e8171f
RS
434(defvar menu-bar-update-buffers-maxbuf)
435
09642d97
RS
436(defun menu-bar-select-buffer ()
437 (interactive)
438 (switch-to-buffer last-command-event))
439
440(defun menu-bar-select-frame ()
441 (interactive)
442 (make-frame-visible last-command-event)
443 (raise-frame last-command-event)
444 (select-frame last-command-event))
445
c171b42f
RS
446(defun menu-bar-update-buffers-1 (elt)
447 (cons (format
08e8171f 448 (format "%%%ds %%s%%s %%s" menu-bar-update-buffers-maxbuf)
c171b42f
RS
449 (cdr elt)
450 (if (buffer-modified-p (car elt))
451 "*" " ")
452 (save-excursion
453 (set-buffer (car elt))
454 (if buffer-read-only "%" " "))
455 (let ((file
456 (or (buffer-file-name (car elt))
457 (save-excursion
458 (set-buffer (car elt))
459 list-buffers-directory)
460 "")))
461 (setq file (or (file-name-directory file)
462 ""))
463 (if (> (length file) 20)
464 (setq file (concat "..." (substring file -17))))
465 file))
466 (car elt)))
467
06ff7539
RS
468(defvar menu-bar-buffers-menu-list-buffers-entry nil)
469
09642d97 470(defun menu-bar-update-buffers ()
29397c58 471 ;; If user discards the Buffers item, play along.
4d587a6c 472 (and (lookup-key (current-global-map) [menu-bar buffer])
29397c58
RS
473 (frame-or-buffer-changed-p)
474 (let ((buffers (buffer-list))
475 (frames (frame-list))
476 buffers-menu frames-menu)
477 ;; If requested, list only the N most recently selected buffers.
478 (if (and (integerp buffers-menu-max-size)
479 (> buffers-menu-max-size 1))
480 (if (> (length buffers) buffers-menu-max-size)
481 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
482
483 ;; Make the menu of buffers proper.
484 (setq buffers-menu
485 (cons "Select Buffer"
c171b42f
RS
486 (let* ((buffer-list
487 (mapcar 'list buffers))
488 tail
08e8171f 489 (menu-bar-update-buffers-maxbuf 0)
c171b42f
RS
490 (maxlen 0)
491 alist
492 head)
493 ;; Put into each element of buffer-list
494 ;; the name for actual display,
495 ;; perhaps truncated in the middle.
496 (setq tail buffer-list)
497 (while tail
498 (let ((name (buffer-name (car (car tail)))))
499 (setcdr (car tail)
500 (if (> (length name) 27)
501 (concat (substring name 0 12)
502 "..."
503 (substring name -12))
504 name)))
505 (setq tail (cdr tail)))
506 ;; Compute the maximum length of any name.
507 (setq tail buffer-list)
29397c58 508 (while tail
c171b42f 509 (or (eq ?\ (aref (cdr (car tail)) 0))
08e8171f
RS
510 (setq menu-bar-update-buffers-maxbuf
511 (max menu-bar-update-buffers-maxbuf
c171b42f 512 (length (cdr (car tail))))))
29397c58 513 (setq tail (cdr tail)))
c171b42f
RS
514 ;; Set ALIST to an alist of the form
515 ;; ITEM-STRING . BUFFER
516 (setq tail buffer-list)
29397c58
RS
517 (while tail
518 (let ((elt (car tail)))
c171b42f 519 (or (eq ?\ (aref (cdr elt) 0))
29397c58 520 (setq alist (cons
c171b42f 521 (menu-bar-update-buffers-1 elt)
29397c58
RS
522 alist)))
523 (and alist (> (length (car (car alist))) maxlen)
524 (setq maxlen (length (car (car alist))))))
525 (setq tail (cdr tail)))
526 (setq alist (nreverse alist))
06ff7539
RS
527 ;; Make the menu item for list-buffers
528 ;; or reuse the one we already have.
529 ;; The advantage in reusing one
530 ;; is that it already has the keyboard equivalent
531 ;; cached, so we save the time to look that up again.
532 (or menu-bar-buffers-menu-list-buffers-entry
533 (setq menu-bar-buffers-menu-list-buffers-entry
534 (cons
535 'list-buffers
536 (cons
537 ""
538 'list-buffers))))
539 ;; Update the item string for menu's new width.
540 (setcar (cdr menu-bar-buffers-menu-list-buffers-entry)
541 (concat (make-string (max (- (/ maxlen 2) 8) 0)
542 ?\ )
543 "List All Buffers"))
544 ;; Now make the actual list of items,
545 ;; ending with the list-buffers item.
29397c58
RS
546 (nconc (mapcar '(lambda (pair)
547 ;; This is somewhat risque, to use
548 ;; the buffer name itself as the event
549 ;; type to define, but it works.
550 ;; It would not work to use the buffer
551 ;; since a buffer as an event has its
552 ;; own meaning.
553 (nconc (list (buffer-name (cdr pair))
554 (car pair)
555 (cons nil nil))
556 'menu-bar-select-buffer))
557 alist)
06ff7539 558 (list menu-bar-buffers-menu-list-buffers-entry)))))
29397c58
RS
559
560
561 ;; Make a Frames menu if we have more than one frame.
562 (if (cdr frames)
563 (setq frames-menu
564 (cons "Select Frame"
565 (mapcar '(lambda (frame)
566 (nconc (list frame
567 (cdr (assq 'name
568 (frame-parameters frame)))
569 (cons nil nil))
570 'menu-bar-select-frame))
571 frames))))
572 (if buffers-menu
573 (setq buffers-menu (cons 'keymap buffers-menu)))
574 (if frames-menu
575 (setq frames-menu (cons 'keymap frames-menu)))
4d587a6c 576 (define-key (current-global-map) [menu-bar buffer]
29397c58
RS
577 (cons "Buffers"
578 (if (and buffers-menu frames-menu)
579 (list 'keymap "Buffers and Frames"
580 (cons 'buffers (cons "Buffers" buffers-menu))
581 (cons 'frames (cons "Frames" frames-menu)))
582 (or buffers-menu frames-menu 'undefined)))))))
09642d97
RS
583
584(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
2f1139a4 585
3f557298
RS
586(menu-bar-update-buffers)
587
40954111
RS
588;; this version is too slow
589;;;(defun format-buffers-menu-line (buffer)
590;;; "Returns a string to represent the given buffer in the Buffer menu.
591;;;nil means the buffer shouldn't be listed. You can redefine this."
592;;; (if (string-match "\\` " (buffer-name buffer))
593;;; nil
594;;; (save-excursion
595;;; (set-buffer buffer)
596;;; (let ((size (buffer-size)))
597;;; (format "%s%s %-19s %6s %-15s %s"
598;;; (if (buffer-modified-p) "*" " ")
599;;; (if buffer-read-only "%" " ")
600;;; (buffer-name)
601;;; size
602;;; mode-name
603;;; (or (buffer-file-name) ""))))))
604\f
25b048ee
RS
605;;; Set up a menu bar menu for the minibuffer.
606
607(mapcar
608 (function
609 (lambda (map)
610 (define-key map [menu-bar minibuf]
611 (cons "Minibuf" (make-sparse-keymap "Minibuf")))))
612 (list minibuffer-local-ns-map
613 minibuffer-local-must-match-map
614 minibuffer-local-isearch-map
615 minibuffer-local-map
616 minibuffer-local-completion-map))
617
618(mapcar
619 (function
620 (lambda (map)
621 (define-key map [menu-bar minibuf ?\?]
622 '("List Completions" . minibuffer-completion-help))
623 (define-key map [menu-bar minibuf space]
624 '("Complete Word" . minibuffer-complete-word))
625 (define-key map [menu-bar minibuf tab]
626 '("Complete" . 'minibuffer-complete))
627 ))
628 (list minibuffer-local-must-match-map
629 minibuffer-local-completion-map))
630
631(mapcar
632 (function
633 (lambda (map)
634 (define-key map [menu-bar minibuf quit]
635 '("Quit" . keyboard-escape-quit))
636 (define-key map [menu-bar minibuf return]
637 '("Enter" . exit-minibuffer))
638 ))
639 (list minibuffer-local-ns-map
640 minibuffer-local-must-match-map
641 minibuffer-local-isearch-map
642 minibuffer-local-map
643 minibuffer-local-completion-map))
644\f
7b7d6615
RS
645(defvar menu-bar-mode nil)
646
057d49d1 647(defun menu-bar-mode (flag)
dfd29450 648 "Toggle display of a menu bar on each frame.
057d49d1
RS
649This command applies to all frames that exist and frames to be
650created in the future.
651With a numeric argument, if the argument is negative,
dfd29450 652turn off menu bars; otherwise, turn on menu bars."
dad8e392 653 (interactive "P")
dad8e392 654
7b7d6615
RS
655 ;; Make menu-bar-mode and default-frame-alist consistent.
656 (let ((default (assq 'menu-bar-lines default-frame-alist)))
657 (if default
658 (setq menu-bar-mode (not (eq (cdr default) 0)))
659 (setq default-frame-alist
660 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
661 default-frame-alist))))
662
663 ;; Toggle or set the mode, according to FLAG.
664 (setq menu-bar-mode (if (null flag) (not menu-bar-mode)
665 (> (prefix-numeric-value flag) 0)))
666
667 ;; Apply it to default-frame-alist.
668 (let ((parameter (assq 'menu-bar-lines default-frame-alist)))
669 (if (consp parameter)
670 (setcdr parameter (if menu-bar-mode 1 0))
671 (setq default-frame-alist
672 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
673 default-frame-alist))))
674
675 ;; Apply it to existing frames.
676 (let ((frames (frame-list)))
677 (while frames
678 (let ((height (cdr (assq 'height (frame-parameters (car frames))))))
679 (modify-frame-parameters (car frames)
680 (list (cons 'menu-bar-lines
681 (if menu-bar-mode 1 0))))
682 (modify-frame-parameters (car frames)
683 (list (cons 'height height))))
684 (setq frames (cdr frames)))))
1db87953 685
bffa5d4d
RS
686(provide 'menu-bar)
687
235aa29b 688;;; menu-bar.el ends here