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