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