*** empty log message ***
[bpt/emacs.git] / lisp / menu-bar.el
... / ...
CommitLineData
1;;; menu-bar.el --- define a default menu bar.
2
3;; Copyright (C) 1993, 1994, 1995, 2000, 2001 Free Software Foundation, Inc.
4
5;; Author: RMS
6;; Maintainer: FSF
7;; Keywords: internal, mouse
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
26;; Avishai Yacobi suggested some menu rearrangements.
27
28;;; Code:
29
30;;; User options:
31
32(defcustom buffers-menu-max-size 10
33 "*Maximum number of entries which may appear on the Buffers menu.
34If this is 10, then only the ten most-recently-selected buffers are shown.
35If this is nil, then all buffers are shown.
36A large number or nil slows down menu responsiveness."
37 :type '(choice integer
38 (const :tag "All" nil))
39 :group 'mouse)
40
41;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
42;; definitions made in loaddefs.el.
43(or (lookup-key global-map [menu-bar])
44 (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
45(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
46
47;; Force Help item to come last, after the major mode's own items.
48;; The symbol used to be called `help', but that gets confused with the
49;; help key.
50(setq menu-bar-final-items '(help-menu))
51
52(define-key global-map [menu-bar help-menu] (cons "Help" menu-bar-help-menu))
53(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
54(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
55;; This definition is just to show what this looks like.
56;; It gets overridden below when menu-bar-update-buffers is called.
57(define-key global-map [menu-bar buffer]
58 (cons "Buffers" (make-sparse-keymap "Buffers")))
59(defvar menu-bar-options-menu (make-sparse-keymap "Options"))
60(define-key global-map [menu-bar options]
61 (cons "Options" menu-bar-options-menu))
62(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
63(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
64(defvar menu-bar-files-menu (make-sparse-keymap "File"))
65(define-key global-map [menu-bar files] (cons "File" menu-bar-files-menu))
66
67;; This alias is for compatibility with 19.28 and before.
68(defvar menu-bar-file-menu menu-bar-files-menu)
69\f
70;; The "File" menu items
71(define-key menu-bar-files-menu [exit-emacs]
72 '(menu-item "Exit Emacs" save-buffers-kill-emacs
73 :help "Save unsaved buffers, then exit"))
74
75(define-key menu-bar-files-menu [separator-exit]
76 '("--"))
77
78;; Don't use delete-frame as event name because that is a special
79;; event.
80(define-key menu-bar-files-menu [delete-this-frame]
81 '(menu-item "Delete Frame" delete-frame
82 :visible (fboundp 'delete-frame)
83 :enable (delete-frame-enabled-p)
84 :help "Delete currently selected frame"))
85(define-key menu-bar-files-menu [make-frame-on-display]
86 '(menu-item "New Frame on Display..." make-frame-on-display
87 :visible (fboundp 'make-frame-on-display)
88 :help "Open a new frame on another display"))
89(define-key menu-bar-files-menu [make-frame]
90 '(menu-item "New Frame" make-frame-command
91 :visible (fboundp 'make-frame-command)
92 :help "Open a new frame"))
93
94(define-key menu-bar-files-menu [one-window]
95 '(menu-item "Unsplit Windows" delete-other-windows
96 :enable (not (one-window-p t nil))
97 :help "Make selected window fill its frame"))
98
99(define-key menu-bar-files-menu [split-window]
100 '(menu-item "Split Window" split-window-vertically
101 :help "Split selected window in two"))
102
103(define-key menu-bar-files-menu [separator-window]
104 '(menu-item "--"))
105
106(define-key menu-bar-files-menu [ps-print-region]
107 '(menu-item "Postscript Print Region (B+W)" ps-print-region
108 :enable mark-active
109 :help "Pretty-print marked region in black and white to PostScript printer"))
110(define-key menu-bar-files-menu [ps-print-buffer]
111 '(menu-item "Postscript Print Buffer (B+W)" ps-print-buffer
112 :help "Pretty-print current buffer in black and white to PostScript printer"))
113(define-key menu-bar-files-menu [ps-print-region-faces]
114 '(menu-item "Postscript Print Region" ps-print-region-with-faces
115 :enable mark-active
116 :help "Pretty-print marked region to PostScript printer"))
117(define-key menu-bar-files-menu [ps-print-buffer-faces]
118 '(menu-item "Postscript Print Buffer" ps-print-buffer-with-faces
119 :help "Pretty-print current buffer to PostScript printer"))
120(define-key menu-bar-files-menu [print-region]
121 '(menu-item "Print Region" print-region
122 :enable mark-active
123 :help "Print region between mark and current position"))
124(define-key menu-bar-files-menu [print-buffer]
125 '(menu-item "Print Buffer" print-buffer
126 :help "Print current buffer with page headings"))
127
128(define-key menu-bar-files-menu [separator-print]
129 '(menu-item "--"))
130
131(define-key menu-bar-files-menu [recover-session]
132 '(menu-item "Recover Crashed Session..." recover-session
133 :enable (and auto-save-list-file-prefix
134 (file-directory-p
135 (file-name-directory auto-save-list-file-prefix))
136 (directory-files
137 (file-name-directory auto-save-list-file-prefix)
138 nil
139 (concat "\\`"
140 (regexp-quote
141 (file-name-nondirectory
142 auto-save-list-file-prefix)))
143 t))
144 :help "Recover edits from a crashed session"))
145(define-key menu-bar-files-menu [revert-buffer]
146 '(menu-item "Revert Buffer" revert-buffer
147 :enable (or revert-buffer-function
148 revert-buffer-insert-file-contents-function
149 (and (buffer-file-name)
150 (or (buffer-modified-p)
151 (not (verify-visited-file-modtime
152 (current-buffer))))))
153 :help "Re-read current buffer from its file"))
154(define-key menu-bar-files-menu [write-file]
155 '(menu-item "Save Buffer As..." write-file
156 :enable (not (window-minibuffer-p
157 (frame-selected-window menu-updating-frame)))
158 :help "Write current buffer to another file"))
159(define-key menu-bar-files-menu [save-buffer]
160 '(menu-item "Save (current buffer)" save-buffer
161 :enable (and (buffer-modified-p)
162 (buffer-file-name)
163 (not (window-minibuffer-p
164 (frame-selected-window menu-updating-frame))))
165 :help "Save current buffer to its file"))
166
167(define-key menu-bar-files-menu [separator-save]
168 '(menu-item "--"))
169
170(define-key menu-bar-files-menu [kill-buffer]
171 '(menu-item "Close (current buffer)" kill-this-buffer
172 :enable (kill-this-buffer-enabled-p)
173 :help "Discard current buffer"))
174(define-key menu-bar-files-menu [insert-file]
175 '(menu-item "Insert File..." insert-file
176 :enable (not (window-minibuffer-p
177 (frame-selected-window menu-updating-frame)))
178 :help "Insert another file into current buffer"))
179(define-key menu-bar-files-menu [dired]
180 '(menu-item "Open Directory..." dired
181 :help "Read a directory, operate on its files"))
182(define-key menu-bar-files-menu [open-file]
183 '(menu-item "Open File..." find-file
184 :enable (not (window-minibuffer-p
185 (frame-selected-window menu-updating-frame)))
186 :help "Read a file into an Emacs buffer"))
187
188\f
189;; The "Edit" menu items
190(defun nonincremental-search-forward (string)
191 "Read a string and search for it nonincrementally."
192 (interactive "sSearch for string: ")
193 (if (equal string "")
194 (search-forward (car search-ring))
195 (isearch-update-ring string nil)
196 (search-forward string)))
197
198(defun nonincremental-search-backward (string)
199 "Read a string and search backward for it nonincrementally."
200 (interactive "sSearch for string: ")
201 (if (equal string "")
202 (search-backward (car search-ring))
203 (isearch-update-ring string nil)
204 (search-backward string)))
205
206(defun nonincremental-re-search-forward (string)
207 "Read a regular expression and search for it nonincrementally."
208 (interactive "sSearch for regexp: ")
209 (if (equal string "")
210 (re-search-forward (car regexp-search-ring))
211 (isearch-update-ring string t)
212 (re-search-forward string)))
213
214(defun nonincremental-re-search-backward (string)
215 "Read a regular expression and search backward for it nonincrementally."
216 (interactive "sSearch for regexp: ")
217 (if (equal string "")
218 (re-search-backward (car regexp-search-ring))
219 (isearch-update-ring string t)
220 (re-search-backward string)))
221
222(defun nonincremental-repeat-search-forward ()
223 "Search forward for the previous search string."
224 (interactive)
225 (if (null search-ring)
226 (error "No previous search"))
227 (search-forward (car search-ring)))
228
229(defun nonincremental-repeat-search-backward ()
230 "Search backward for the previous search string."
231 (interactive)
232 (if (null search-ring)
233 (error "No previous search"))
234 (search-backward (car search-ring)))
235
236(defun nonincremental-repeat-re-search-forward ()
237 "Search forward for the previous regular expression."
238 (interactive)
239 (if (null regexp-search-ring)
240 (error "No previous search"))
241 (re-search-forward (car regexp-search-ring)))
242
243(defun nonincremental-repeat-re-search-backward ()
244 "Search backward for the previous regular expression."
245 (interactive)
246 (if (null regexp-search-ring)
247 (error "No previous search"))
248 (re-search-backward (car regexp-search-ring)))
249
250(defvar menu-bar-search-menu (make-sparse-keymap "Search"))
251(defvar menu-bar-adv-search-menu
252 (make-sparse-keymap "Advanced Search/Replace"))
253
254(define-key menu-bar-adv-search-menu [tags-continue]
255 '(menu-item "Continue Tags Search/Replace" tags-loop-continue
256 :help "Continue last tags search/replace operation"))
257(define-key menu-bar-adv-search-menu [tags-repl]
258 '(menu-item "Replace in all tagged files" tags-query-replace
259 :help "Interactively replace a regexp in all tagged files"))
260(define-key menu-bar-adv-search-menu [tags-srch]
261 '(menu-item "Search in all tagged files" tags-search
262 :help "Search for a regexp in all tagged files"))
263
264(define-key menu-bar-adv-search-menu [separator-tag-search]
265 '(menu-item "--"))
266
267(define-key menu-bar-adv-search-menu [query-replace-regexp]
268 '(menu-item "Replace Regexp..." query-replace-regexp
269 :enable (not buffer-read-only)
270 :help "Replace regular expression, ask about each occurrence"))
271(define-key menu-bar-adv-search-menu [repeat-regexp-back]
272 '(menu-item "Repeat Regexp Backwards"
273 nonincremental-repeat-re-search-backward
274 :enable regexp-search-ring
275 :help "Repeat last regular expression search backwards"))
276(define-key menu-bar-adv-search-menu [repeat-regexp-fwd]
277 '(menu-item "Repeat Regexp" nonincremental-repeat-re-search-forward
278 :enable regexp-search-ring
279 :help "Repeat last regular expression search forward"))
280(define-key menu-bar-adv-search-menu [re-search-backward]
281 '(menu-item "Search Regexp Backwards..." nonincremental-re-search-backward
282 :help "Search backwards for a regular expression"))
283(define-key menu-bar-adv-search-menu [re-search-forward]
284 '(menu-item "Search Regexp..." nonincremental-re-search-forward
285 :help "Search forward for a regular expression"))
286(define-key menu-bar-search-menu [re-search]
287 (list 'menu-item "Advanced Search/Replace" menu-bar-adv-search-menu
288 :help "Regexp and Tags search and replace"))
289
290(define-key menu-bar-search-menu [query-replace]
291 '(menu-item "Replace..." query-replace
292 :enable (not buffer-read-only)
293 :help "Replace string interactively, ask about each occurrence"))
294(define-key menu-bar-search-menu [repeat-search-back]
295 '(menu-item "Repeat Backwards" nonincremental-repeat-search-backward
296 :enable search-ring
297 :help "Repeat last search backwards"))
298(define-key menu-bar-search-menu [repeat-search-fwd]
299 '(menu-item "Repeat Search" nonincremental-repeat-search-forward
300 :enable search-ring
301 :help "Repeat last search forward"))
302(define-key menu-bar-search-menu [search-backward]
303 '(menu-item "Search Backwards..." nonincremental-search-backward
304 :help "Search backwards for a string"))
305(define-key menu-bar-search-menu [search-forward]
306 '(menu-item "Search..." nonincremental-search-forward
307 :help "Search forward for a string"))
308
309;;; Assemble the top-level Edit menu items.
310(define-key menu-bar-edit-menu [props]
311 '(menu-item "Text Properties" facemenu-menu
312 :help "Change properties of text in region"))
313
314(define-key menu-bar-search-menu [separator-search]
315 '(menu-item "--"))
316
317(define-key menu-bar-edit-menu [bookmark]
318 '(menu-item "Bookmarks" menu-bar-bookmark-map
319 :help "Record positions and jump between them"))
320
321(define-key menu-bar-edit-menu [separator-bookmark]
322 '(menu-item "--"))
323
324(defvar menu-bar-goto-menu (make-sparse-keymap "Go To"))
325
326(define-key menu-bar-goto-menu [set-tags-name]
327 '(menu-item "Set Tags File Name" visit-tags-table
328 :help "Tell Tags commands which tag table file to use"))
329
330(define-key menu-bar-goto-menu [separator-tag-file]
331 '(menu-item "--"))
332
333(define-key menu-bar-goto-menu [apropos-tags]
334 '(menu-item "Tags Apropos" tags-apropos
335 :help "Find function/variables whose names match regexp"))
336(define-key menu-bar-goto-menu [next-tag-otherw]
337 '(menu-item "Next Tag in Other Window"
338 (function (lambda () (find-tag-other-window nil t)))
339 :enable (and (boundp 'tags-location-ring)
340 (not (ring-empty-p tags-location-ring)))
341 :help "Find next function/variable matching last tag name in another window"))
342(define-key menu-bar-goto-menu [next-tag]
343 '(menu-item "Find Next Tag"
344 (function (lambda () (find-tag nil t)))
345 :enable (and (boundp 'tags-location-ring)
346 (not (ring-empty-p tags-location-ring)))
347 :help "Find next function/variable matching last tag name"))
348(define-key menu-bar-goto-menu [find-tag-otherw]
349 '(menu-item "Find Tag in Other Window..." find-tag-other-window
350 :help "Find function/variable definition in another window"))
351(define-key menu-bar-goto-menu [find-tag]
352 '(menu-item "Find Tag..." find-tag
353 :help "Find definition of function or variable"))
354
355(define-key menu-bar-goto-menu [separator-tags]
356 '(menu-item "--"))
357
358(define-key menu-bar-goto-menu [end-of-buf]
359 '(menu-item "Goto End of Buffer" end-of-buffer))
360(define-key menu-bar-goto-menu [beg-of-buf]
361 '(menu-item "Goto Beginning of Buffer" beginning-of-buffer))
362(define-key menu-bar-goto-menu [go-to-pos]
363 '(menu-item "Goto Buffer Position..." goto-char
364 :help "Read a number N and go to buffer position N"))
365(define-key menu-bar-goto-menu [go-to-line]
366 '(menu-item "Goto Line..." goto-line
367 :help "Read a line number and go to that line"))
368
369(define-key menu-bar-edit-menu [goto]
370 (list 'menu-item "Go To" menu-bar-goto-menu))
371
372(define-key menu-bar-edit-menu [search]
373 (list 'menu-item "Search" menu-bar-search-menu))
374
375(define-key menu-bar-edit-menu [fill]
376 '(menu-item "Fill" fill-region
377 :enable (and mark-active (not buffer-read-only))
378 :help
379 "Fill text in region to fit between left and right margin"))
380(define-key menu-bar-edit-menu [mark-whole-buffer]
381 '(menu-item "Select All" mark-whole-buffer
382 :help "Mark the whole buffer for a subsequent cut/copy."))
383(define-key menu-bar-edit-menu [clear]
384 '(menu-item "Clear" delete-region
385 :enable (and mark-active
386 (not buffer-read-only)
387 (not (mouse-region-match)))
388 :help
389 "Delete the text in region between mark and current position"))
390(defvar yank-menu (cons "Select Yank" nil))
391(fset 'yank-menu (cons 'keymap yank-menu))
392(define-key menu-bar-edit-menu [select-paste]
393 '(menu-item "Select and Paste" yank-menu
394 :enable (and (cdr yank-menu) (not buffer-read-only))
395 :help "Paste text cut/copied earlier"))
396(define-key menu-bar-edit-menu [paste]
397 '(menu-item "Paste" yank
398 :enable (and (x-selection-exists-p) (not buffer-read-only))
399 :help "Paste text most recently cut/copied"))
400(define-key menu-bar-edit-menu [copy]
401 '(menu-item "Copy" menu-bar-kill-ring-save
402 :enable mark-active
403 :help "Copy text in region between mark and current position"))
404(define-key menu-bar-edit-menu [cut]
405 '(menu-item "Cut" kill-region
406 :enable (and mark-active (not buffer-read-only))
407 :help
408 "Cut (kill) text in region between mark and current position"))
409(define-key menu-bar-edit-menu [undo]
410 '(menu-item "Undo" undo
411 :enable (and (not buffer-read-only)
412 (not (eq t buffer-undo-list))
413 (if (eq last-command 'undo)
414 pending-undo-list
415 (consp buffer-undo-list)))
416 :help "Undo last operation"))
417
418
419(defun menu-bar-kill-ring-save (beg end)
420 (interactive "r")
421 (if (mouse-region-match)
422 (message "Selecting a region with the mouse does `copy' automatically")
423 (kill-ring-save beg end)))
424
425(autoload 'ispell-menu-map "ispell" nil t 'keymap)
426
427;; These are alternative definitions for the cut, paste and copy
428;; menu items. Use them if your system expects these to use the clipboard.
429
430(put 'clipboard-kill-region 'menu-enable 'mark-active)
431(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
432(put 'clipboard-yank 'menu-enable
433 '(or (x-selection-exists-p) (x-selection-exists-p 'CLIPBOARD)))
434
435(defun clipboard-yank ()
436 "Insert the clipboard contents, or the last stretch of killed text."
437 (interactive)
438 (let ((x-select-enable-clipboard t))
439 (yank)))
440
441(defun clipboard-kill-ring-save (beg end)
442 "Copy region to kill ring, and save in the X clipboard."
443 (interactive "r")
444 (let ((x-select-enable-clipboard t))
445 (kill-ring-save beg end)))
446
447(defun clipboard-kill-region (beg end)
448 "Kill the region, and save it in the X clipboard."
449 (interactive "r")
450 (let ((x-select-enable-clipboard t))
451 (kill-region beg end)))
452
453(defun menu-bar-enable-clipboard ()
454 "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
455Do the same for the keys of the same name."
456 (interactive)
457 ;; We can't use constant list structure here because it becomes pure,
458 ;; and because it gets modified with cache data.
459 (define-key menu-bar-edit-menu [paste]
460 (cons "Paste" (cons "Paste text from clipboard" 'clipboard-yank)))
461 (define-key menu-bar-edit-menu [copy]
462 (cons "Copy" (cons "Copy text in region to the clipboard"
463 'clipboard-kill-ring-save)))
464 (define-key menu-bar-edit-menu [cut]
465 (cons "Cut" (cons "Delete text in region and copy it to the clipboard"
466 'clipboard-kill-region)))
467
468 (define-key global-map [f20] 'clipboard-kill-region)
469 (define-key global-map [f16] 'clipboard-kill-ring-save)
470 (define-key global-map [f18] 'clipboard-yank)
471 ;; X11R6 versions
472 (define-key global-map [cut] 'clipboard-kill-region)
473 (define-key global-map [copy] 'clipboard-kill-ring-save)
474 (define-key global-map [paste] 'clipboard-yank))
475\f
476;; The "Options" menu items
477
478(defvar menu-bar-custom-menu (make-sparse-keymap "Customize"))
479
480(define-key menu-bar-custom-menu [customize-apropos-groups]
481 '(menu-item "Groups Matching Regexp..." customize-apropos-groups
482 :help "Browse groups whose names match regexp"))
483(define-key menu-bar-custom-menu [customize-apropos-faces]
484 '(menu-item "Faces Matching Regexp..." customize-apropos-faces
485 :help "Browse faces whose names match regexp"))
486(define-key menu-bar-custom-menu [customize-apropos-options]
487 '(menu-item "Options Matching Regexp..." customize-apropos-options
488 :help "Browse options whose names match regexp"))
489(define-key menu-bar-custom-menu [customize-apropos]
490 '(menu-item "Settings Matching Regexp..." customize-apropos
491 :help "Browse customizable settings whose names match regexp"))
492(define-key menu-bar-custom-menu [separator-2]
493 '("--"))
494(define-key menu-bar-custom-menu [customize-group]
495 '(menu-item "Specific Group..." customize-group
496 :help "Customize settings of specific group"))
497(define-key menu-bar-custom-menu [customize-face]
498 '(menu-item "Specific Face..." customize-face
499 :help "Customize attributes of specific face"))
500(define-key menu-bar-custom-menu [customize-option]
501 '(menu-item "Specific Option..." customize-option
502 :help "Change value of specific option"))
503(define-key menu-bar-custom-menu [customize-changed-options]
504 '(menu-item "Recently Changed Options..." customize-changed-options
505 :help "Customize options changed in recent versions"))
506(define-key menu-bar-custom-menu [separator-3]
507 '("--"))
508(define-key menu-bar-custom-menu [customize-browse]
509 '(menu-item "Browse Customization Groups" customize-browse
510 :help "Browse all customization groups"))
511(define-key menu-bar-custom-menu [customize]
512 '(menu-item "Top-level Customization Group" customize
513 :help "The master group called `Emacs'"))
514
515;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
516
517(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
518 `(progn
519 (defun ,name ()
520 ,(concat doc ".")
521 (interactive)
522 (if ,(if body `(progn . ,body)
523 `(setq ,variable (not ,variable)))
524 (message ,message "enabled")
525 (message ,message "disabled")))
526 '(menu-item ,doc ,name
527 :help ,help
528 :button (:toggle . (and (boundp ',variable) ,variable)))))
529
530;;; Assemble all the top-level items of the "Options" menu
531(define-key menu-bar-options-menu [customize]
532 (list 'menu-item "Customize Emacs" menu-bar-custom-menu
533 :help "Full customization of every Emacs feature"))
534
535(defun menu-bar-options-save ()
536 "Save current values of Options menu items using Custom."
537 (interactive)
538 (dolist (elt '(debug-on-quit debug-on-error auto-compression-mode
539 case-fold-search truncate-lines show-paren-mode
540 transient-mark-mode global-font-lock-mode
541 current-language-environment default-input-method))
542 (if (default-value elt)
543 (customize-save-variable elt (default-value elt))))
544 (if (memq 'turn-on-auto-fill text-mode-hook)
545 (customize-save-variable 'text-mode-hook
546 (default-value 'text-mode-hook)))
547 (if (featurep 'saveplace)
548 (customize-save-variable 'save-place (default-value 'save-place)))
549 (if (featurep 'uniquify)
550 (customize-save-variable 'uniquify-buffer-name-style
551 (default-value 'uniquify-buffer-name-style))))
552
553(define-key menu-bar-options-menu [save]
554 '(menu-item "Save Options" menu-bar-options-save
555 :help "Save options set from the menu above"))
556
557(define-key menu-bar-options-menu [custom-separator]
558 '("--"))
559
560(define-key menu-bar-options-menu [mule]
561 ;; It is better not to use backquote here,
562 ;; because that makes a bootstrapping problem
563 ;; if you need to recompile all the Lisp files using interpreted code.
564 (list 'menu-item "Mule (Multilingual Environment)" mule-menu-keymap
565;; Most of the MULE menu actually does make sense in unibyte mode,
566;; e.g. language selection.
567;;; ':visible 'default-enable-multibyte-characters
568 ':help "Default language, encodings, input method"))
569;(setq menu-bar-final-items (cons 'mule menu-bar-final-items))
570;(define-key menu-bar-options-menu [preferences]
571; (list 'menu-item "Preferences" menu-bar-preferences-menu
572; :help "Toggle important global options"))
573
574(define-key menu-bar-options-menu [mule-separator]
575 '("--"))
576
577(define-key menu-bar-options-menu [debug-on-quit]
578 (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
579 "Toggle whether to enter the Lisp Debugger on Quit/C-g"
580 "Debug on Quit %s"
581 "Enter Lisp debugger when C-g is pressed"))
582(define-key menu-bar-options-menu [debug-on-error]
583 (menu-bar-make-toggle toggle-debug-on-error debug-on-error
584 "Toggle whether to enter the Lisp Debugger on Error"
585 "Debug on Error %s"
586 "Enter Lisp debugger when error is signaled"))
587(define-key menu-bar-options-menu [debugger-separator]
588 '("--"))
589(define-key menu-bar-options-menu [toggle-auto-compression]
590 '(menu-item "Automatic File De/compression"
591 auto-compression-mode
592 :help "Transparently decompress compressed files"
593 :button (:toggle . (rassq 'jka-compr-handler
594 file-name-handler-alist))))
595(define-key menu-bar-options-menu [save-place]
596 (menu-bar-make-toggle toggle-save-place-globally save-place
597 "Save Place in Files between Sessions"
598 "Saving place in files %s"
599 "Save Emacs state for next session"
600 (require 'saveplace)
601 (setq-default save-place
602 (not (default-value save-place)))))
603(define-key menu-bar-options-menu [uniquify]
604 (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style
605 "Use Directory Names in Buffer Names"
606 "Directory name in buffer names (uniquify) %s"
607 "Uniquify a buffer name by adding parent directory names until unique"
608 (require 'uniquify)
609 (setq uniquify-buffer-name-style
610 (if (not uniquify-buffer-name-style)
611 'forward))))
612(define-key menu-bar-options-menu [edit-options-separator]
613 '("--"))
614(define-key menu-bar-options-menu [case-fold-search]
615 (menu-bar-make-toggle toggle-case-fold-search case-fold-search
616 "Case-Insensitive Search"
617 "Case-Insensitive Search %s"
618 "If checked, search ignores letter-case"))
619(define-key menu-bar-options-menu [auto-fill-mode]
620 '(menu-item "Word Wrap in Text Modes (Auto Fill)"
621 toggle-text-mode-auto-fill
622 :help "Automatically fill text between left and right margins"
623 :button (:toggle . (member 'turn-on-auto-fill text-mode-hook))))
624(define-key menu-bar-options-menu [truncate-lines]
625 (menu-bar-make-toggle
626 toggle-truncate-lines truncate-lines
627 "Truncate Long Lines in this Buffer" "Long Line Truncation %s"
628 "If checked, long lines are truncated on the screen"
629 (prog1 (setq truncate-lines (not truncate-lines))
630 (set-buffer-modified-p (buffer-modified-p)))))
631(define-key menu-bar-options-menu [highlight-separator]
632 '("--"))
633(define-key menu-bar-options-menu [highlight-paren-mode]
634 (menu-bar-make-toggle toggle-highlight-paren-mode show-paren-mode
635 "Highlight Matching Parentheses"
636 "Show Paren mode %s"
637 "Highlight matching and mismatched parentheses"))
638(define-key menu-bar-options-menu [transient-mark-mode]
639 (menu-bar-make-toggle toggle-transient-mark-mode transient-mark-mode
640 "Transient Mark Mode (highlights region)"
641 "Transient Mark mode %s"
642 "Highlight the marked region when it's active"))
643(define-key menu-bar-options-menu [toggle-global-lazy-font-lock-mode]
644 (menu-bar-make-toggle toggle-global-lazy-font-lock-mode global-font-lock-mode
645 "Highlight Syntax (Global Font Lock)"
646 "Syntax Highlighting %s"
647 "Highlights text based on language syntax"
648 (global-font-lock-mode)))
649
650\f
651;; The "Tools" menu items
652
653(defun send-mail-item-name ()
654 (let* ((known-send-mail-commands '((sendmail-user-agent . "sendmail")
655 (mh-e-user-agent . "MH")
656 (message-user-agent . "Gnus Message")
657 (gnus-user-agent . "Gnus")))
658 (name (assq mail-user-agent known-send-mail-commands)))
659 (if name
660 (setq name (cdr name))
661 (setq name (symbol-name mail-user-agent))
662 (if (string-match "\\(.+\\)-user-agent" name)
663 (setq name (match-string 1 name))))
664 name))
665
666(defun read-mail-item-name ()
667 (let* ((known-rmail-commands '((rmail . "RMAIL")
668 (mh-rmail . "MH")
669 (gnus . "Gnus")))
670 (known (assq read-mail-command known-rmail-commands)))
671 (if known (cdr known) (symbol-name read-mail-command))))
672
673(defvar menu-bar-games-menu (make-sparse-keymap "Games"))
674
675(define-key menu-bar-tools-menu [games]
676 (list 'menu-item "Games" menu-bar-games-menu))
677
678(define-key menu-bar-tools-menu [separator-games]
679 '("--"))
680
681(define-key menu-bar-games-menu [zone]
682 '(menu-item "Zone Out" zone
683 :help "Play tricks with Emacs display when Emacs is idle"))
684(define-key menu-bar-games-menu [yow]
685 '(menu-item "Random Quotation" yow
686 :help "Display a random Zippy quotation"))
687(define-key menu-bar-games-menu [tetris]
688 '(menu-item "Tetris" tetris))
689(define-key menu-bar-games-menu [solitaire]
690 '(menu-item "Solitaire" solitaire))
691(define-key menu-bar-games-menu [snake]
692 '(menu-item "Snake" snake
693 :help "Move snake around avoiding collisions"))
694(define-key menu-bar-games-menu [mult]
695 '(menu-item "Multiplication Puzzle" mpuz
696 :help "Excercise brain with multiplication"))
697(define-key menu-bar-games-menu [life]
698 '(menu-item "Life" life
699 :help "Watch how John Conway's cellular automaton evolves"))
700(define-key menu-bar-games-menu [hanoi]
701 '(menu-item "Towers of Hanoi" hanoi
702 :help "Watch Towers-of-Hanoi puzzle solved by Emacs"))
703(define-key menu-bar-games-menu [gomoku]
704 '(menu-item "Gomoku" gomoku
705 :help "Mark 5 contiguous squares (like tic-tac-toe)"))
706(define-key menu-bar-games-menu [black-box]
707 '(menu-item "Blackbox" blackbox
708 :help "Find balls in a black box by shooting rays"))
709(define-key menu-bar-games-menu [adventure]
710 '(menu-item "Adventure" dunnet
711 :help "Dunnet, a text Adventure game for Emacs"))
712(define-key menu-bar-games-menu [5x5]
713 '(menu-item "5x5" 5x5
714 :help "Fill in all the squares on a 5x5 board"))
715
716(define-key menu-bar-tools-menu [calendar]
717 '(menu-item "Display Calendar" calendar))
718(define-key menu-bar-tools-menu [speedbar]
719 '(menu-item "Display Speedbar" speedbar-frame-mode))
720(define-key menu-bar-tools-menu [directory-search]
721 '(menu-item "Directory Search" eudc-tools-menu
722 :help "Query directory servers via LDAP, CCSO PH/QI or BBDB"))
723(define-key menu-bar-tools-menu [compose-mail]
724 (list
725 'menu-item `(format "Send Mail (with %s)" (send-mail-item-name))
726 'compose-mail
727 :visible `(and mail-user-agent (not (eq mail-user-agent 'ignore)))
728 :help "Send a mail message"))
729(define-key menu-bar-tools-menu [rmail]
730 (list
731 'menu-item `(format "Read Mail (with %s)" (read-mail-item-name))
732 (lambda ()
733 (interactive)
734 (call-interactively read-mail-command))
735 :visible `(and read-mail-command (not (eq read-mail-command 'ignore)))
736 :help "Read your mail and reply to it"))
737(define-key menu-bar-tools-menu [gnus]
738 '(menu-item "Read Net News (Gnus)" gnus
739 :help "Read network news groups"))
740
741(define-key menu-bar-tools-menu [separator-vc]
742 '("--"))
743
744(defvar vc-menu-map (make-sparse-keymap "Version Control"))
745(define-key menu-bar-tools-menu [pcl-cvs]
746 `(menu-item "PCL-CVS" ,cvs-global-menu
747 :help "Module-level interface to CVS"))
748(define-key menu-bar-tools-menu [vc]
749 (list 'menu-item "Version Control" vc-menu-map
750 :help "Interface to RCS, CVS, SCCS"))
751
752(define-key menu-bar-tools-menu [separator-compare]
753 '("--"))
754
755(define-key menu-bar-tools-menu [ediff-misc]
756 '(menu-item "Ediff Miscellanea" menu-bar-ediff-misc-menu
757 :help "Ediff manual, customization, sessions, etc."))
758(define-key menu-bar-tools-menu [epatch]
759 '(menu-item "Apply Patch" menu-bar-epatch-menu))
760(define-key menu-bar-tools-menu [ediff-merge]
761 '(menu-item "Merge" menu-bar-ediff-merge-menu
762 :help "Merge different revisions of files/directories"))
763(define-key menu-bar-tools-menu [compare]
764 '(menu-item "Compare (Ediff)" menu-bar-ediff-menu
765 :help "Display differences between files/directories"))
766
767
768(define-key menu-bar-tools-menu [separator-spell]
769 '("--"))
770
771(define-key menu-bar-tools-menu [spell]
772 '(menu-item "Spell Checking" ispell-menu-map))
773
774(define-key menu-bar-tools-menu [separator-prog]
775 '("--"))
776
777(define-key menu-bar-tools-menu [gdb]
778 '(menu-item "Debugger (GUD)..." gdb
779 :help "Debug a program from within Emacs"))
780(define-key menu-bar-tools-menu [shell-on-region]
781 '(menu-item "Shell Command on Region..." shell-command-on-region
782 :enable mark-active
783 :help "Pass marked region to a shell command"))
784(define-key menu-bar-tools-menu [shell]
785 '(menu-item "Shell Command..." shell-command
786 :help "Invoke a shell command and catch its output"))
787(define-key menu-bar-tools-menu [compile]
788 '(menu-item "Compile..." compile
789 :help "Invoke compiler or Make, view compilation errors"))
790(define-key menu-bar-tools-menu [grep]
791 '(menu-item "Search Files (Grep)..." grep
792 :help "Search files for strings or regexps (with Grep)"))
793
794\f
795;; The "Help" menu items
796
797(defvar menu-bar-describe-menu (make-sparse-keymap "Describe"))
798
799(define-key menu-bar-describe-menu [mule-diag]
800 '(menu-item "Show All of Mule Status" mule-diag
801 :visible default-enable-multibyte-characters
802 :help "Display multilingual environment settings"))
803(define-key menu-bar-describe-menu [describe-coding-system]
804 '(menu-item "Describe Coding System..." describe-coding-system
805 :visible default-enable-multibyte-characters))
806(define-key menu-bar-describe-menu [describe-input-method]
807 '(menu-item "Describe Input Method..." describe-input-method
808 :visible default-enable-multibyte-characters
809 :help "Keyboard layout for specific input method"))
810(define-key menu-bar-describe-menu [describe-language-environment]
811 (list 'menu-item "Describe Language Environment"
812 describe-language-environment-map
813 :help "Show multilingual settings for a specific language"))
814
815(define-key menu-bar-describe-menu [separator-desc-mule]
816 '("--"))
817
818(define-key menu-bar-describe-menu [list-keybindings]
819 '(menu-item "List Key Bindings" describe-bindings
820 :help "Display a list of all current keybindings"))
821(define-key menu-bar-describe-menu [list-keybindings]
822 '(menu-item "List Key Bindings" describe-bindings
823 :help "Display a list of all current keybindings"))
824(define-key menu-bar-describe-menu [describe-variable]
825 '(menu-item "Describe Variable..." describe-variable
826 :help "Display documentation of variable/option"))
827(define-key menu-bar-describe-menu [describe-function]
828 '(menu-item "Describe Function..." describe-function
829 :help "Display documentation of function/command"))
830(define-key menu-bar-describe-menu [describe-key]
831 '(menu-item "Describe Key..." describe-key
832 ;; Users typically don't identify keys and menu items...
833 :help "Display documentation of command bound to a \
834key (or menu-item)"))
835(define-key menu-bar-describe-menu [apropos-variables]
836 '(menu-item "Apropos Variables..." apropos-variable
837 :help "List variables whose names match a regexp"))
838(define-key menu-bar-describe-menu [apropos-commands]
839 '(menu-item "Apropos Commands..." apropos-command
840 :help "List commands whose names match a regexp"))
841(define-key menu-bar-describe-menu [describe-mode]
842 '(menu-item "Describe Buffer Modes" describe-mode
843 :help "Describe this buffer's major and minor mode"))
844
845(defvar menu-bar-manuals-menu (make-sparse-keymap "Manuals"))
846
847(define-key menu-bar-manuals-menu [man]
848 '(menu-item "Read Man Page..." manual-entry
849 :help "Man-page docs for external commands and libraries"))
850(define-key menu-bar-manuals-menu [sep2]
851 '("--"))
852(define-key menu-bar-manuals-menu [info]
853 '(menu-item "Browse Manuals with Info" Info-directory
854 :help "Read any of the installed manuals"))
855(define-key menu-bar-manuals-menu [command]
856 '(menu-item "Find Command in Manual" Info-goto-emacs-command-node
857 :help "Display manual section that describes a command"))
858(define-key menu-bar-manuals-menu [key]
859 '(menu-item "Find Key in Manual" Info-goto-emacs-key-command-node
860 :help "Display manual section that describes a key"))
861
862(define-key menu-bar-help-menu [eliza]
863 '(menu-item "Emacs Psychiatrist" doctor
864 :help "Our doctor will help you feel better"))
865(define-key menu-bar-help-menu [sep3]
866 '("--"))
867(define-key menu-bar-help-menu [describe-no-warranty]
868 '(menu-item "(Non)Warranty" describe-no-warranty
869 :help "Explain that Emacs has NO WARRANTY"))
870(define-key menu-bar-help-menu [describe-copying]
871 '(menu-item "Copying Conditions" describe-copying
872 :help "Show the Emacs license (GPL)"))
873(define-key menu-bar-help-menu [describe-distribution]
874 '(menu-item "Getting New Versions" describe-distribution
875 :help "How to get latest versions of Emacs"))
876(define-key menu-bar-help-menu [more]
877 '(menu-item "Find Extra Packages"
878 (lambda ()
879 (interactive)
880 (let (enable-local-variables)
881 (view-file (expand-file-name "MORE.STUFF"
882 data-directory))
883 (goto-address)))
884 :help "Where to find some extra packages and possible updates"))
885(define-key menu-bar-help-menu [emacs-version]
886 '(menu-item "Show Emacs Version" emacs-version))
887(define-key menu-bar-help-menu [sep2]
888 '("--"))
889(define-key menu-bar-help-menu [finder-by-keyword]
890 '(menu-item "Find Emacs Packages..." finder-by-keyword
891 :help "Find packages and features by keyword"))
892(define-key menu-bar-help-menu [describe]
893 (list 'menu-item "Describe" menu-bar-describe-menu
894 :help "Describe commands, variables, keys"))
895(define-key menu-bar-help-menu [manuals]
896 (list 'menu-item "Manuals" menu-bar-manuals-menu
897 :help "Lookup commands and keys in docs, read manuals"))
898(define-key menu-bar-help-menu [sep1]
899 '("--"))
900(define-key menu-bar-help-menu [report-emacs-bug]
901 '(menu-item "Send Bug Report..." report-emacs-bug
902 :help "Send e-mail to Emacs maintainers"))
903(define-key menu-bar-help-menu [order-emacs-manuals]
904 '(menu-item "Ordering Manuals" view-order-manuals
905 :help "How to order manuals from the Free Software Foundation"))
906(define-key menu-bar-help-menu [emacs-manual]
907 '(menu-item "Read the Emacs Manual"
908 (lambda () (interactive) (info "emacs"))))
909(define-key menu-bar-help-menu [emacs-problems]
910 '(menu-item "Emacs Known Problems" view-emacs-problems))
911(define-key menu-bar-help-menu [emacs-news]
912 '(menu-item "Emacs News" view-emacs-news
913 :help "New features of this version"))
914(define-key menu-bar-help-menu [emacs-faq]
915 '(menu-item "Emacs FAQ" view-emacs-FAQ))
916(define-key menu-bar-help-menu [emacs-tutorial-language-specific]
917 '(menu-item "Emacs Tutorial (choose language)..."
918 (lambda () (interactive) (help-with-tutorial t))
919 :help "Learn how to use Emacs (choose a language)"))
920(define-key menu-bar-help-menu [emacs-tutorial]
921 '(menu-item "Emacs Tutorial" help-with-tutorial
922 :help "Learn how to use Emacs"))
923
924(defun kill-this-buffer () ; for the menubar
925 "Kill the current buffer."
926 (interactive)
927 (kill-buffer (current-buffer)))
928
929(defun kill-this-buffer-enabled-p ()
930 (let ((count 0)
931 (buffers (buffer-list)))
932 (while buffers
933 (or (string-match "^ " (buffer-name (car buffers)))
934 (setq count (1+ count)))
935 (setq buffers (cdr buffers)))
936 (and (not (window-minibuffer-p (frame-selected-window menu-updating-frame)))
937 (> count 1))))
938
939(put 'dired 'menu-enable
940 '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
941
942;; Permit deleting frame if it would leave a visible or iconified frame.
943(defun delete-frame-enabled-p ()
944 "Return non-nil if `delete-frame' should be enabled in the menu bar."
945 (let ((frames (frame-list))
946 (count 0))
947 (while frames
948 (if (frame-visible-p (car frames))
949 (setq count (1+ count)))
950 (setq frames (cdr frames)))
951 (> count 1)))
952
953(defcustom yank-menu-length 20
954 "*Maximum length to display in the yank-menu."
955 :type 'integer
956 :group 'mouse)
957
958(defun menu-bar-update-yank-menu (string old)
959 (let ((front (car (cdr yank-menu)))
960 (menu-string (if (<= (length string) yank-menu-length)
961 string
962 (concat
963 (substring string 0 (/ yank-menu-length 2))
964 "..."
965 (substring string (- (/ yank-menu-length 2)))))))
966 ;; Don't let the menu string be all dashes
967 ;; because that has a special meaning in a menu.
968 (if (string-match "\\`-+\\'" menu-string)
969 (setq menu-string (concat menu-string " ")))
970 ;; If we're supposed to be extending an existing string, and that
971 ;; string really is at the front of the menu, then update it in place.
972 (if (and old (or (eq old (car front))
973 (string= old (car front))))
974 (progn
975 (setcar front string)
976 (setcar (cdr front) menu-string))
977 (setcdr yank-menu
978 (cons
979 (cons string (cons menu-string 'menu-bar-select-yank))
980 (cdr yank-menu)))))
981 (if (> (length (cdr yank-menu)) kill-ring-max)
982 (setcdr (nthcdr kill-ring-max yank-menu) nil)))
983
984(put 'menu-bar-select-yank 'apropos-inhibit t)
985(defun menu-bar-select-yank ()
986 (interactive "*")
987 (push-mark (point))
988 (insert last-command-event))
989\f
990(defvar list-buffers-directory nil)
991
992(defvar menu-bar-update-buffers-maxbuf)
993
994(defun menu-bar-select-buffer ()
995 (interactive)
996 (switch-to-buffer last-command-event))
997
998(defun menu-bar-select-frame ()
999 (interactive)
1000 (let (frame)
1001 (dolist (f (frame-list))
1002 (when (equal last-command-event (frame-parameter f 'name))
1003 (setq frame f)))
1004 (make-frame-visible frame)
1005 (raise-frame frame)
1006 (select-frame frame)))
1007
1008(defun menu-bar-update-buffers-1 (elt)
1009 (cons (format
1010 (format "%%%ds %%s%%s %%s" menu-bar-update-buffers-maxbuf)
1011 (cdr elt)
1012 (if (buffer-modified-p (car elt))
1013 "*" " ")
1014 (save-excursion
1015 (set-buffer (car elt))
1016 (if buffer-read-only "%" " "))
1017 (let ((file
1018 (or (buffer-file-name (car elt))
1019 (save-excursion
1020 (set-buffer (car elt))
1021 list-buffers-directory)
1022 "")))
1023 (setq file (or (file-name-directory file)
1024 ""))
1025 (if (> (length file) 20)
1026 (setq file (concat "..." (substring file -17))))
1027 file))
1028 (car elt)))
1029
1030(defvar menu-bar-buffers-menu-list-buffers-entry nil)
1031
1032(defun menu-bar-update-buffers (&optional force)
1033 ;; If user discards the Buffers item, play along.
1034 (and (lookup-key (current-global-map) [menu-bar buffer])
1035 (or force (frame-or-buffer-changed-p))
1036 (let ((buffers (buffer-list))
1037 (frames (frame-list))
1038 (maxlen 0)
1039 buffers-menu frames-menu)
1040 ;; If requested, list only the N most recently selected buffers.
1041 (if (and (integerp buffers-menu-max-size)
1042 (> buffers-menu-max-size 1))
1043 (if (> (length buffers) buffers-menu-max-size)
1044 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
1045
1046 ;; Make the menu of buffers proper.
1047 (setq buffers-menu
1048 (cons "Select Buffer"
1049 (let* ((buffer-list
1050 (mapcar 'list buffers))
1051 tail
1052 (menu-bar-update-buffers-maxbuf 0)
1053 alist
1054 head)
1055 ;; Put into each element of buffer-list
1056 ;; the name for actual display,
1057 ;; perhaps truncated in the middle.
1058 (setq tail buffer-list)
1059 (while tail
1060 (let ((name (buffer-name (car (car tail)))))
1061 (setcdr (car tail)
1062 (if (> (length name) 27)
1063 (concat (substring name 0 12)
1064 "..."
1065 (substring name -12))
1066 name)))
1067 (setq tail (cdr tail)))
1068 ;; Compute the maximum length of any name.
1069 (setq tail buffer-list)
1070 (while tail
1071 (or (eq ?\ (aref (cdr (car tail)) 0))
1072 (setq menu-bar-update-buffers-maxbuf
1073 (max menu-bar-update-buffers-maxbuf
1074 (length (cdr (car tail))))))
1075 (setq tail (cdr tail)))
1076 ;; Set ALIST to an alist of the form
1077 ;; ITEM-STRING . BUFFER
1078 (setq tail buffer-list)
1079 (while tail
1080 (let ((elt (car tail)))
1081 (or (eq ?\ (aref (cdr elt) 0))
1082 (setq alist (cons
1083 (menu-bar-update-buffers-1 elt)
1084 alist)))
1085 (and alist (> (length (car (car alist))) maxlen)
1086 (setq maxlen (length (car (car alist))))))
1087 (setq tail (cdr tail)))
1088 (setq alist (nreverse alist))
1089 ;; Make the menu item for list-buffers
1090 ;; or reuse the one we already have.
1091 ;; The advantage in reusing one
1092 ;; is that it already has the keyboard equivalent
1093 ;; cached, so we save the time to look that up again.
1094 (or menu-bar-buffers-menu-list-buffers-entry
1095 (setq menu-bar-buffers-menu-list-buffers-entry
1096 (cons
1097 'list-buffers
1098 (cons
1099 ""
1100 'list-buffers))))
1101 ;; Update the item string for menu's new width.
1102 (setcar (cdr menu-bar-buffers-menu-list-buffers-entry)
1103 (concat (make-string (max (- (/ maxlen 2) 8) 0)
1104 ?\ )
1105 "List All Buffers"))
1106 ;; Now make the actual list of items,
1107 ;; ending with the list-buffers item.
1108 (nconc (mapcar (lambda (pair)
1109 ;; This is somewhat risque, to use
1110 ;; the buffer name itself as the event
1111 ;; type to define, but it works.
1112 ;; It would not work to use the buffer
1113 ;; since a buffer as an event has its
1114 ;; own meaning.
1115 (nconc (list (buffer-name (cdr pair))
1116 (car pair)
1117 (cons nil nil))
1118 'menu-bar-select-buffer))
1119 alist)
1120 (list menu-bar-buffers-menu-list-buffers-entry)))))
1121
1122
1123 ;; Make a Frames menu if we have more than one frame.
1124 (if (cdr frames)
1125 (let ((name (concat (make-string (max (- (/ maxlen 2) 3) 0)
1126 ?\ )
1127 "Frames"))
1128 (frames-menu
1129 (cons 'keymap
1130 (cons "Select Frame"
1131 (mapcar
1132 (lambda (frame)
1133 (nconc
1134 (list (frame-parameter frame 'name)
1135 (frame-parameter frame 'name)
1136 (cons nil nil))
1137 'menu-bar-select-frame))
1138 frames)))))
1139 ;; Put it underneath the Buffers menu.
1140 (setq buffers-menu (cons (cons 'frames (cons name frames-menu))
1141 buffers-menu))))
1142 (if buffers-menu
1143 (setq buffers-menu (cons 'keymap buffers-menu)))
1144 (define-key (current-global-map) [menu-bar buffer]
1145 (cons "Buffers" buffers-menu)))))
1146
1147(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
1148
1149(menu-bar-update-buffers)
1150
1151;; this version is too slow
1152;;;(defun format-buffers-menu-line (buffer)
1153;;; "Returns a string to represent the given buffer in the Buffer menu.
1154;;;nil means the buffer shouldn't be listed. You can redefine this."
1155;;; (if (string-match "\\` " (buffer-name buffer))
1156;;; nil
1157;;; (save-excursion
1158;;; (set-buffer buffer)
1159;;; (let ((size (buffer-size)))
1160;;; (format "%s%s %-19s %6s %-15s %s"
1161;;; (if (buffer-modified-p) "*" " ")
1162;;; (if buffer-read-only "%" " ")
1163;;; (buffer-name)
1164;;; size
1165;;; mode-name
1166;;; (or (buffer-file-name) ""))))))
1167\f
1168;;; Set up a menu bar menu for the minibuffer.
1169
1170(dolist (map (list minibuffer-local-ns-map
1171 minibuffer-local-must-match-map
1172 minibuffer-local-isearch-map
1173 minibuffer-local-map
1174 minibuffer-local-completion-map))
1175 (define-key map [menu-bar minibuf]
1176 (cons "Minibuf" (make-sparse-keymap "Minibuf"))))
1177
1178(dolist (map (list minibuffer-local-must-match-map
1179 minibuffer-local-completion-map))
1180 (define-key map [menu-bar minibuf ?\?]
1181 (list 'menu-item "List Completions" 'minibuffer-completion-help
1182 :help "Display all possible completions"))
1183 (define-key map [menu-bar minibuf space]
1184 (list 'menu-item "Complete Word" 'minibuffer-complete-word
1185 :help "Complete at most one word"))
1186 (define-key map [menu-bar minibuf tab]
1187 (list 'menu-item "Complete" 'minibuffer-complete
1188 :help "Complete as far as possible")))
1189
1190(dolist (map (list minibuffer-local-ns-map
1191 minibuffer-local-must-match-map
1192 minibuffer-local-isearch-map
1193 minibuffer-local-map
1194 minibuffer-local-completion-map))
1195 (define-key map [menu-bar minibuf quit]
1196 (list 'menu-item "Quit" 'keyboard-escape-quit
1197 :help "Abort input and exit minibuffer"))
1198 (define-key map [menu-bar minibuf return]
1199 (list 'menu-item "Enter" 'exit-minibuffer
1200 :help "Terminate input and exit minibuffer")))
1201\f
1202(defcustom menu-bar-mode nil
1203 "Toggle display of a menu bar on each frame.
1204Setting this variable directly does not take effect;
1205use either \\[customize] or the function `menu-bar-mode'."
1206 :set (lambda (symbol value)
1207 (menu-bar-mode (or value 0)))
1208 :initialize 'custom-initialize-default
1209 :type 'boolean
1210 :group 'frames)
1211
1212(defun menu-bar-mode (flag)
1213 "Toggle display of a menu bar on each frame.
1214This command applies to all frames that exist and frames to be
1215created in the future.
1216With a numeric argument, if the argument is positive,
1217turn on menu bars; otherwise, turn off menu bars."
1218 (interactive "P")
1219
1220 ;; Make menu-bar-mode and default-frame-alist consistent.
1221 (let ((default (assq 'menu-bar-lines default-frame-alist)))
1222 (if default
1223 (setq menu-bar-mode (not (eq (cdr default) 0)))
1224 (setq default-frame-alist
1225 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
1226 default-frame-alist))))
1227
1228 ;; Toggle or set the mode, according to FLAG.
1229 (setq menu-bar-mode (if (null flag) (not menu-bar-mode)
1230 (> (prefix-numeric-value flag) 0)))
1231
1232 ;; Apply it to default-frame-alist.
1233 (let ((parameter (assq 'menu-bar-lines default-frame-alist)))
1234 (if (consp parameter)
1235 (setcdr parameter (if menu-bar-mode 1 0))
1236 (setq default-frame-alist
1237 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
1238 default-frame-alist))))
1239
1240 ;; Apply it to existing frames.
1241 (let ((frames (frame-list)))
1242 (while frames
1243 (let ((height (cdr (assq 'height (frame-parameters (car frames))))))
1244 (modify-frame-parameters (car frames)
1245 (list (cons 'menu-bar-lines
1246 (if menu-bar-mode 1 0))))
1247 (modify-frame-parameters (car frames)
1248 (list (cons 'height height))))
1249 (setq frames (cdr frames)))))
1250
1251(provide 'menu-bar)
1252
1253;;; menu-bar.el ends here