(make_terminal_frame): Initialize frame foreground and
[bpt/emacs.git] / lisp / menu-bar.el
CommitLineData
235aa29b
ER
1;;; menu-bar.el --- define a default menu bar.
2
506c6d61 3;; Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
b578f267 4
235aa29b 5;; Author: RMS
e4874521 6;; Maintainer: FSF
dbcee71a 7;; Keywords: internal, mouse
235aa29b 8
1db87953
RS
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
b578f267
EN
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.
1db87953 25
260130bb
KH
26;; Avishai Yacobi suggested some menu rearrangements.
27
b578f267
EN
28;;; Code:
29
d537086b
RS
30;;; User options:
31
30e19aee 32(defcustom buffers-menu-max-size 10
d537086b
RS
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.
30e19aee
RS
36A large number or nil slows down menu responsiveness."
37 :type '(choice integer
38 (const :tag "All" nil))
39 :group 'mouse)
d537086b 40
b132f2b1
RM
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")))
22390f50 45(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
ffbdd83d
RS
46
47;; Force Help item to come last, after the major mode's own items.
0d31efcd
KH
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))
ffbdd83d 51
0d31efcd 52(define-key global-map [menu-bar help-menu] (cons "Help" menu-bar-help-menu))
ffbdd83d
RS
53(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
54(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
7f315c7c
EZ
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))
1b009b97
RS
66
67;; This alias is for compatibility with 19.28 and before.
68(defvar menu-bar-file-menu menu-bar-files-menu)
9bb8e471 69\f
7f315c7c 70;; The "File" menu items
ffbdd83d 71(define-key menu-bar-files-menu [exit-emacs]
7f315c7c
EZ
72 '(menu-item "Exit Emacs" save-buffers-kill-emacs
73 :help "Save unsaved buffers, then exit"))
ffbdd83d
RS
74
75(define-key menu-bar-files-menu [separator-exit]
76 '("--"))
77
7f315c7c
EZ
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
ffbdd83d 94(define-key menu-bar-files-menu [one-window]
7f315c7c
EZ
95 '(menu-item "Unsplit Windows" delete-other-windows
96 :enable (not (one-window-p t nil))
97 :help "Make selected window fill its frame"))
ffbdd83d
RS
98
99(define-key menu-bar-files-menu [split-window]
7f315c7c
EZ
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 "--"))
9bb8e471 123
f3e1e0dd 124(define-key menu-bar-files-menu [recover-session]
7f315c7c
EZ
125 '(menu-item "Recover Crashed Session..." recover-session
126 :enable (and auto-save-list-file-prefix
db3ca487
NF
127 (file-directory-p
128 (file-name-directory auto-save-list-file-prefix))
129 (directory-files
7f315c7c
EZ
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"))
ffbdd83d 138(define-key menu-bar-files-menu [revert-buffer]
7f315c7c
EZ
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"))
ffbdd83d 147(define-key menu-bar-files-menu [write-file]
7f315c7c
EZ
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
9bb8e471 180\f
7f315c7c 181;; The "Edit" menu items
ffbdd83d
RS
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
1f50590a 214(defun nonincremental-repeat-search-forward ()
ffbdd83d
RS
215 "Search forward for the previous search string."
216 (interactive)
008c8493
RS
217 (if (null search-ring)
218 (error "No previous search"))
ffbdd83d
RS
219 (search-forward (car search-ring)))
220
1f50590a 221(defun nonincremental-repeat-search-backward ()
ffbdd83d
RS
222 "Search backward for the previous search string."
223 (interactive)
008c8493
RS
224 (if (null search-ring)
225 (error "No previous search"))
ffbdd83d
RS
226 (search-backward (car search-ring)))
227
1f50590a 228(defun nonincremental-repeat-re-search-forward ()
ffbdd83d
RS
229 "Search forward for the previous regular expression."
230 (interactive)
97565dd9 231 (if (null regexp-search-ring)
008c8493 232 (error "No previous search"))
ffbdd83d
RS
233 (re-search-forward (car regexp-search-ring)))
234
1f50590a 235(defun nonincremental-repeat-re-search-backward ()
ffbdd83d
RS
236 "Search backward for the previous regular expression."
237 (interactive)
97565dd9 238 (if (null regexp-search-ring)
008c8493 239 (error "No previous search"))
ffbdd83d
RS
240 (re-search-backward (car regexp-search-ring)))
241
7f315c7c
EZ
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"))
ffbdd83d 281
7f315c7c
EZ
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"))
fe74180c 286(define-key menu-bar-search-menu [repeat-search-back]
7f315c7c
EZ
287 '(menu-item "Repeat Backwards" nonincremental-repeat-search-backward
288 :enable search-ring
289 :help "Repeat last search backwards"))
fe74180c 290(define-key menu-bar-search-menu [repeat-search-fwd]
7f315c7c
EZ
291 '(menu-item "Repeat Search" nonincremental-repeat-search-forward
292 :enable search-ring
293 :help "Repeat last search forward"))
fe74180c 294(define-key menu-bar-search-menu [search-backward]
7f315c7c
EZ
295 '(menu-item "Search Backwards..." nonincremental-search-backward
296 :help "Search backwards for a string"))
fe74180c 297(define-key menu-bar-search-menu [search-forward]
7f315c7c
EZ
298 '(menu-item "Search..." nonincremental-search-forward
299 :help "Search forward for a string"))
9bb8e471 300
7f315c7c
EZ
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"))
3dd92899 305
7f315c7c
EZ
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)))
0ae27881
EZ
331 :enable (and (boundp 'tags-location-ring)
332 (not (ring-empty-p tags-location-ring)))
7f315c7c
EZ
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)))
0ae27881
EZ
337 :enable (and (boundp 'tags-location-ring)
338 (not (ring-empty-p tags-location-ring)))
7f315c7c
EZ
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"))
496b7491
EZ
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."))
7f315c7c
EZ
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"))
3dd92899
KH
382(defvar yank-menu (cons "Select Yank" nil))
383(fset 'yank-menu (cons 'keymap yank-menu))
7f315c7c
EZ
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
057d49d1 409
4c0317b1
RS
410(defun menu-bar-kill-ring-save (beg end)
411 (interactive "r")
412 (if (mouse-region-match)
b1a4cc61 413 (message "Selecting a region with the mouse does `copy' automatically")
4c0317b1
RS
414 (kill-ring-save beg end)))
415
9e18f0a0
RS
416(autoload 'ispell-menu-map "ispell" nil t 'keymap)
417
f9cf0be2 418;; These are alternative definitions for the cut, paste and copy
4c0317b1 419;; menu items. Use them if your system expects these to use the clipboard.
f9cf0be2 420
f9cf0be2
RS
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 ()
ee497664 427 "Insert the clipboard contents, or the last stretch of killed text."
f9cf0be2
RS
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 ()
5cbdeb30
RS
445 "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
446Do the same for the keys of the same name."
f9cf0be2 447 (interactive)
5754d7f2
RS
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]
7f315c7c 451 (cons "Paste" (cons "Paste text from clipboard" 'clipboard-yank)))
5754d7f2 452 (define-key menu-bar-edit-menu [copy]
7f315c7c
EZ
453 (cons "Copy" (cons "Copy text in region to the clipboard"
454 'clipboard-kill-ring-save)))
5754d7f2 455 (define-key menu-bar-edit-menu [cut]
7f315c7c
EZ
456 (cons "Cut" (cons "Delete text in region and copy it to the clipboard"
457 'clipboard-kill-region)))
5cbdeb30
RS
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))
f9cf0be2 466\f
7f315c7c 467;; The "Options" menu items
a9f53ffb
RS
468
469(defvar menu-bar-custom-menu (make-sparse-keymap "Customize"))
470
b0f661de 471(define-key menu-bar-custom-menu [customize-apropos-groups]
7f315c7c
EZ
472 '(menu-item "Groups Matching Regexp..." customize-apropos-groups
473 :help "Browse groups whose names match regexp"))
b0f661de 474(define-key menu-bar-custom-menu [customize-apropos-faces]
7f315c7c
EZ
475 '(menu-item "Faces Matching Regexp..." customize-apropos-faces
476 :help "Browse faces whose names match regexp"))
b0f661de 477(define-key menu-bar-custom-menu [customize-apropos-options]
7f315c7c
EZ
478 '(menu-item "Options Matching Regexp..." customize-apropos-options
479 :help "Browse options whose names match regexp"))
a9f53ffb 480(define-key menu-bar-custom-menu [customize-apropos]
7f315c7c
EZ
481 '(menu-item "Settings Matching Regexp..." customize-apropos
482 :help "Browse customizable settings whose names match regexp"))
b0f661de
RS
483(define-key menu-bar-custom-menu [separator-2]
484 '("--"))
c9a86e71 485(define-key menu-bar-custom-menu [customize-group]
7f315c7c
EZ
486 '(menu-item "Specific Group..." customize-group
487 :help "Customize settings of specific group"))
a9f53ffb 488(define-key menu-bar-custom-menu [customize-face]
7f315c7c
EZ
489 '(menu-item "Specific Face..." customize-face
490 :help "Customize attributes of specific face"))
b0f661de 491(define-key menu-bar-custom-menu [customize-option]
7f315c7c
EZ
492 '(menu-item "Specific Option..." customize-option
493 :help "Change value of specific option"))
6fe9c658 494(define-key menu-bar-custom-menu [customize-changed-options]
7f315c7c
EZ
495 '(menu-item "Recently Changed Options..." customize-changed-options
496 :help "Customize options changed in recent versions"))
b0f661de
RS
497(define-key menu-bar-custom-menu [separator-3]
498 '("--"))
e6354b3e 499(define-key menu-bar-custom-menu [customize-browse]
7f315c7c
EZ
500 '(menu-item "Browse Customization Groups" customize-browse
501 :help "Browse all customization groups"))
b0f661de 502(define-key menu-bar-custom-menu [customize]
7f315c7c
EZ
503 '(menu-item "Top-level Customization Group" customize
504 :help "The master group called `Emacs'"))
a9f53ffb 505
7f315c7c 506;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
bacb2d12 507
7f315c7c 508(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
bacb2d12
RS
509 `(progn
510 (defun ,name ()
511 ,(concat doc ".")
512 (interactive)
513 (if ,(if body `(progn . ,body)
514 `(setq ,variable (not ,variable)))
506c6d61
DL
515 (message ,message "enabled")
516 (message ,message "disabled")))
7f315c7c
EZ
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"))
10013d74
DL
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]
48c9f054 545 '(menu-item "Save Options" menu-bar-options-save
10013d74
DL
546 :help "Save options set from the menu above"))
547
548(define-key menu-bar-options-menu [custom-separator]
549 '("--"))
550
7f315c7c
EZ
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
506c6d61
DL
556;; Most of the MULE menu actually does make sense in unibyte mode,
557;; e.g. language selection.
558;;; ':visible 'default-enable-multibyte-characters
7f315c7c
EZ
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]
506c6d61 566 '("--"))
bacb2d12
RS
567
568(define-key menu-bar-options-menu [debug-on-quit]
569 (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
7f315c7c
EZ
570 "Enter Debugger on Quit/C-g" "Debug on Quit %s"
571 "Enter Lisp debugger when C-g is pressed"))
bacb2d12
RS
572(define-key menu-bar-options-menu [debug-on-error]
573 (menu-bar-make-toggle toggle-debug-on-error debug-on-error
7f315c7c
EZ
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]
bacb2d12 577 '("--"))
7f315c7c
EZ
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))))
bacb2d12
RS
584(define-key menu-bar-options-menu [save-place]
585 (menu-bar-make-toggle toggle-save-place-globally save-place
89f1709f 586 "Save Place in Files between Sessions"
bacb2d12 587 "Saving place in files %s"
7f315c7c 588 "Save Emacs state for next session"
89f1709f 589 (require 'saveplace)
10013d74
DL
590 (setq-default save-place
591 (not (default-value save-place)))))
bacb2d12
RS
592(define-key menu-bar-options-menu [uniquify]
593 (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style
89f1709f 594 "Use Directory Names in Buffer Names"
bacb2d12 595 "Directory name in buffer names (uniquify) %s"
7f315c7c 596 nil
bacb2d12
RS
597 (require 'uniquify)
598 (setq uniquify-buffer-name-style
599 (if (not uniquify-buffer-name-style)
600 'forward))))
7f315c7c
EZ
601(define-key menu-bar-options-menu [edit-options-separator]
602 '("--"))
3f51f129
RS
603(define-key menu-bar-options-menu [case-fold-search]
604 (menu-bar-make-toggle toggle-case-fold-search case-fold-search
7f315c7c
EZ
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))))
43c35fd7
RS
613(define-key menu-bar-options-menu [truncate-lines]
614 (menu-bar-make-toggle
615 toggle-truncate-lines truncate-lines
506c6d61 616 "Truncate Long Lines in this Buffer" "Long Line Truncation %s"
7f315c7c 617 "If checked, long lines are truncated on the screen"
43c35fd7
RS
618 (prog1 (setq truncate-lines (not truncate-lines))
619 (set-buffer-modified-p (buffer-modified-p)))))
7f315c7c
EZ
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"))
bacb2d12
RS
627(define-key menu-bar-options-menu [transient-mark-mode]
628 (menu-bar-make-toggle toggle-transient-mark-mode transient-mark-mode
89f1709f 629 "Transient Mark Mode (highlights region)"
7f315c7c
EZ
630 "Transient Mark mode %s"
631 "Highlight the marked region when it's active"))
8ad97b87 632(define-key menu-bar-options-menu [toggle-global-lazy-font-lock-mode]
89f1709f 633 (menu-bar-make-toggle toggle-global-lazy-font-lock-mode global-font-lock-mode
7f315c7c
EZ
634 "Highlight Syntax (Global Font Lock)"
635 "Syntax Highlighting %s"
636 "Highlights text based on language syntax"
dbcee71a 637 (global-font-lock-mode)))
7f315c7c 638
e5683624 639\f
7f315c7c
EZ
640;; The "Tools" menu items
641
642(defvar menu-bar-games-menu (make-sparse-keymap "Games"))
643
644(define-key menu-bar-tools-menu [games]
645 (list 'menu-item "Games" menu-bar-games-menu))
646
647(define-key menu-bar-tools-menu [separator-games]
648 '("--"))
649
7bff37dc
EZ
650(define-key menu-bar-games-menu [zone]
651 '(menu-item "Zone Out" zone
652 :help "Play tricks with Emacs display when Emacs is idle"))
7f315c7c
EZ
653(define-key menu-bar-games-menu [yow]
654 '(menu-item "Random Quotation" yow
655 :help "Display a random Zippy quotation"))
656(define-key menu-bar-games-menu [tetris]
657 '(menu-item "Tetris" tetris))
658(define-key menu-bar-games-menu [solitaire]
659 '(menu-item "Solitaire" solitaire))
660(define-key menu-bar-games-menu [snake]
661 '(menu-item "Snake" snake
662 :help "Move snake around avoiding collisions"))
663(define-key menu-bar-games-menu [mult]
664 '(menu-item "Multiplication Puzzle" mpuz
665 :help "Excercise brain with multiplication"))
666(define-key menu-bar-games-menu [life]
667 '(menu-item "Life" life
668 :help "Watch how John Conway's cellular automaton evolves"))
669(define-key menu-bar-games-menu [hanoi]
670 '(menu-item "Towers of Hanoi" hanoi
671 :help "Watch Towers-of-Hanoi puzzle solved by Emacs"))
672(define-key menu-bar-games-menu [gomoku]
673 '(menu-item "Gomoku" gomoku
674 :help "Mark 5 contiguous squares (like tic-tac-toe)"))
675(define-key menu-bar-games-menu [black-box]
676 '(menu-item "Blackbox" blackbox
677 :help "Find balls in a black box by shooting rays"))
678(define-key menu-bar-games-menu [adventure]
679 '(menu-item "Adventure" dunnet
680 :help "Dunnet, a text Adventure game for Emacs"))
681(define-key menu-bar-games-menu [5x5]
682 '(menu-item "5x5" 5x5
683 :help "Fill in all the squares on a 5x5 board"))
684
506c6d61 685(define-key menu-bar-tools-menu [calendar]
7f315c7c
EZ
686 '(menu-item "Display Calendar" calendar))
687(define-key menu-bar-tools-menu [speedbar]
688 '(menu-item "Display Speedbar" speedbar-frame-mode))
689(define-key menu-bar-tools-menu [directory-search]
690 '(menu-item "Directory Search" eudc-tools-menu
691 :help "Query directory servers via LDAP, CCSO PH/QI or BBDB"))
506c6d61 692(define-key menu-bar-tools-menu [compose-mail]
7f315c7c
EZ
693 '(menu-item "Send Mail" compose-mail
694 :help "Send a mail message"))
506c6d61 695(define-key menu-bar-tools-menu [rmail]
b2df30a6
GM
696 '(menu-item "Read Mail" (lambda ()
697 (interactive)
698 (call-interactively read-mail-command))
7f315c7c
EZ
699 :help "Read your mail and reply to it"))
700(define-key menu-bar-tools-menu [gnus]
701 '(menu-item "Read Net News" gnus
702 :help "Read network news groups"))
703
704(define-key menu-bar-tools-menu [separator-vc]
705 '("--"))
706
707(defvar vc-menu-map (make-sparse-keymap "Version Control"))
eccd9bd5
SM
708(define-key menu-bar-tools-menu [pcl-cvs]
709 `(menu-item "PCL-CVS" ,cvs-global-menu
710 :help "Module-level interface to CVS"))
7f315c7c
EZ
711(define-key menu-bar-tools-menu [vc]
712 (list 'menu-item "Version Control" vc-menu-map
713 :help "Interface to RCS, CVS, SCCS"))
714
715(define-key menu-bar-tools-menu [separator-compare]
716 '("--"))
717
718(define-key menu-bar-tools-menu [ediff-misc]
719 '(menu-item "Ediff Miscellanea" menu-bar-ediff-misc-menu
720 :help "Ediff manual, customization, sessions, etc."))
721(define-key menu-bar-tools-menu [epatch]
722 '(menu-item "Apply Patch" menu-bar-epatch-menu))
723(define-key menu-bar-tools-menu [ediff-merge]
724 '(menu-item "Merge" menu-bar-ediff-merge-menu
725 :help "Merge different revisions of files/directories"))
726(define-key menu-bar-tools-menu [compare]
727 '(menu-item "Compare (Ediff)" menu-bar-ediff-menu
728 :help "Display differences between files/directories"))
729
730
731(define-key menu-bar-tools-menu [separator-spell]
732 '("--"))
733
734(define-key menu-bar-tools-menu [spell]
735 '(menu-item "Spell Checking" ispell-menu-map))
736
737(define-key menu-bar-tools-menu [separator-prog]
738 '("--"))
739
740(define-key menu-bar-tools-menu [gdb]
741 '(menu-item "Debugger (GUD)..." gdb
742 :help "Debug a program from withing Emacs"))
743(define-key menu-bar-tools-menu [shell-on-region]
744 '(menu-item "Shell Command on Region..." shell-command-on-region
745 :enable mark-active
746 :help "Pass marked region to a shell command"))
747(define-key menu-bar-tools-menu [shell]
748 '(menu-item "Shell Command..." shell-command
749 :help "Invoke a shell command and catch its output"))
750(define-key menu-bar-tools-menu [compile]
751 '(menu-item "Compile..." compile
752 :help "Invoke compiler or Make, view compilation errors"))
753(define-key menu-bar-tools-menu [grep]
754 '(menu-item "Search Files (Grep)..." grep
755 :help "Search files for strings or regexps (with Grep)"))
756
757\f
758;; The "Help" menu items
759
e5683624
RS
760(defvar menu-bar-describe-menu (make-sparse-keymap "Describe"))
761
7f315c7c
EZ
762(define-key menu-bar-describe-menu [mule-diag]
763 '(menu-item "Show All of Mule Status" mule-diag
764 :visible default-enable-multibyte-characters
765 :help "Display multilingual environment settings"))
766(define-key menu-bar-describe-menu [describe-coding-system]
767 '(menu-item "Describe Coding System..." describe-coding-system
768 :visible default-enable-multibyte-characters))
769(define-key menu-bar-describe-menu [describe-input-method]
770 '(menu-item "Describe Input Method..." describe-input-method
771 :visible default-enable-multibyte-characters
772 :help "Keyboard layout for specific input method"))
773(define-key menu-bar-describe-menu [describe-language-environment]
506c6d61
DL
774 (list 'menu-item "Describe Language Environment"
775 describe-language-environment-map
776 :help "Show multilingual settings for a specific language"))
7f315c7c
EZ
777
778(define-key menu-bar-describe-menu [separator-desc-mule]
506c6d61 779 '("--"))
7f315c7c
EZ
780
781(define-key menu-bar-describe-menu [list-keybindings]
782 '(menu-item "List Key Bindings" describe-bindings
783 :help "Display a list of all current keybindings"))
784(define-key menu-bar-describe-menu [list-keybindings]
785 '(menu-item "List Key Bindings" describe-bindings
786 :help "Display a list of all current keybindings"))
e5683624 787(define-key menu-bar-describe-menu [describe-variable]
7f315c7c
EZ
788 '(menu-item "Describe Variable..." describe-variable
789 :help "Display documentation of variable/option"))
e5683624 790(define-key menu-bar-describe-menu [describe-function]
7f315c7c
EZ
791 '(menu-item "Describe Function..." describe-function
792 :help "Display documentation of function/command"))
e5683624 793(define-key menu-bar-describe-menu [describe-key]
7f315c7c 794 '(menu-item "Describe Key..." describe-key
506c6d61
DL
795 ;; Users typically don't identify keys and menu items...
796 :help "Display documentation of command bound to a \
797key (or menu-item)"))
a16f6b16 798(define-key menu-bar-describe-menu [apropos-variables]
7f315c7c
EZ
799 '(menu-item "Apropos Variables..." apropos-variable
800 :help "List variables whose names match a regexp"))
a16f6b16 801(define-key menu-bar-describe-menu [apropos-commands]
7f315c7c
EZ
802 '(menu-item "Apropos Commands..." apropos-command
803 :help "List commands whose names match a regexp"))
e5683624 804(define-key menu-bar-describe-menu [describe-mode]
7f315c7c
EZ
805 '(menu-item "Describe Buffer Modes" describe-mode
806 :help "Describe this buffer's major and minor mode"))
e5683624
RS
807
808(defvar menu-bar-manuals-menu (make-sparse-keymap "Manuals"))
809
810(define-key menu-bar-manuals-menu [man]
7f315c7c
EZ
811 '(menu-item "Read Man Page..." manual-entry
812 :help "Man-page docs for external commands and libraries"))
e5683624
RS
813(define-key menu-bar-manuals-menu [sep2]
814 '("--"))
e5683624 815(define-key menu-bar-manuals-menu [info]
506c6d61 816 '(menu-item "Browse Manuals with Info" Info-directory
7f315c7c
EZ
817 :help "Read any of the installed manuals"))
818(define-key menu-bar-manuals-menu [command]
819 '(menu-item "Find Command in Manual" Info-goto-emacs-command-node
820 :help "Display manual section that describes a command"))
821(define-key menu-bar-manuals-menu [key]
822 '(menu-item "Find Key in Manual" Info-goto-emacs-key-command-node
823 :help "Display manual section that describes a key"))
bacb2d12 824
7f315c7c
EZ
825(define-key menu-bar-help-menu [eliza]
826 '(menu-item "Emacs Psychiatrist" doctor
827 :help "Our doctor will help you feel better"))
828(define-key menu-bar-help-menu [sep3]
829 '("--"))
f3e1e0dd 830(define-key menu-bar-help-menu [describe-no-warranty]
7f315c7c
EZ
831 '(menu-item "(Non)Warranty" describe-no-warranty
832 :help "Explain that Emacs has NO WARRANTY"))
f3e1e0dd 833(define-key menu-bar-help-menu [describe-copying]
7f315c7c
EZ
834 '(menu-item "Copying Conditions" describe-copying
835 :help "Show the Emacs license (GPL)"))
f3e1e0dd 836(define-key menu-bar-help-menu [describe-distribution]
7f315c7c
EZ
837 '(menu-item "Getting New Versions" describe-distribution
838 :help "How to get latest versions of Emacs"))
efb166ff 839(define-key menu-bar-help-menu [emacs-version]
7f315c7c 840 '(menu-item "Show Emacs Version" emacs-version))
e5683624
RS
841(define-key menu-bar-help-menu [sep2]
842 '("--"))
260130bb 843(define-key menu-bar-help-menu [finder-by-keyword]
7f315c7c
EZ
844 '(menu-item "Find Emacs Packages..." finder-by-keyword
845 :help "Find packages and features by keyword"))
e5683624 846(define-key menu-bar-help-menu [describe]
7f315c7c
EZ
847 (list 'menu-item "Describe" menu-bar-describe-menu
848 :help "Describe commands, variables, keys"))
e5683624 849(define-key menu-bar-help-menu [manuals]
968280cc
EZ
850 (list 'menu-item "Manuals" menu-bar-manuals-menu
851 :help "Lookup commands and keys in docs, read manuals"))
e5683624
RS
852(define-key menu-bar-help-menu [sep1]
853 '("--"))
7f315c7c
EZ
854(define-key menu-bar-help-menu [report-emacs-bug]
855 '(menu-item "Send Bug Report..." report-emacs-bug
856 :help "Send e-mail to Emacs maintainers"))
506c6d61 857(define-key menu-bar-help-menu [emacs-manual]
dbcee71a 858 '(menu-item "Read the Emacs Manual"
506c6d61 859 (lambda () (interactive) (info "emacs"))))
7f315c7c
EZ
860(define-key menu-bar-help-menu [emacs-problems]
861 '(menu-item "Emacs Known Problems" view-emacs-problems))
862(define-key menu-bar-help-menu [emacs-news]
863 '(menu-item "Emacs News" view-emacs-news
864 :help "New features of this version"))
865(define-key menu-bar-help-menu [emacs-faq]
866 '(menu-item "Emacs FAQ" view-emacs-FAQ))
451ec4e3
GM
867(define-key menu-bar-help-menu [emacs-tutorial-language-specific]
868 '(menu-item "Emacs Tutorial (choose language)..."
869 (lambda () (interactive) (help-with-tutorial t))
870 :help "Learn how to use Emacs (choose a language)"))
7f315c7c
EZ
871(define-key menu-bar-help-menu [emacs-tutorial]
872 '(menu-item "Emacs Tutorial" help-with-tutorial
873 :help "Learn how to use Emacs"))
889560ed 874
db774a16 875(defun kill-this-buffer () ; for the menubar
506c6d61 876 "Kill the current buffer."
db774a16
RS
877 (interactive)
878 (kill-buffer (current-buffer)))
879
2f1139a4
RS
880(defun kill-this-buffer-enabled-p ()
881 (let ((count 0)
882 (buffers (buffer-list)))
883 (while buffers
884 (or (string-match "^ " (buffer-name (car buffers)))
885 (setq count (1+ count)))
886 (setq buffers (cdr buffers)))
a6f8cbf1 887 (and (not (window-minibuffer-p (frame-selected-window menu-updating-frame)))
1f50590a
RS
888 (> count 1))))
889
1f50590a 890(put 'dired 'menu-enable
a6f8cbf1 891 '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
1f50590a 892
a0213a97 893;; Permit deleting frame if it would leave a visible or iconified frame.
82a74107
KH
894(defun delete-frame-enabled-p ()
895 "Return non-nil if `delete-frame' should be enabled in the menu bar."
896 (let ((frames (frame-list))
27aa8132
RS
897 (count 0))
898 (while frames
899 (if (frame-visible-p (car frames))
900 (setq count (1+ count)))
901 (setq frames (cdr frames)))
902 (> count 1)))
2f1139a4 903
30e19aee
RS
904(defcustom yank-menu-length 20
905 "*Maximum length to display in the yank-menu."
906 :type 'integer
907 :group 'mouse)
3dd92899
KH
908
909(defun menu-bar-update-yank-menu (string old)
910 (let ((front (car (cdr yank-menu)))
911 (menu-string (if (<= (length string) yank-menu-length)
912 string
c3e1d435
RS
913 (concat
914 (substring string 0 (/ yank-menu-length 2))
915 "..."
916 (substring string (- (/ yank-menu-length 2)))))))
7c70a955
RS
917 ;; Don't let the menu string be all dashes
918 ;; because that has a special meaning in a menu.
919 (if (string-match "\\`-+\\'" menu-string)
920 (setq menu-string (concat menu-string " ")))
3dd92899
KH
921 ;; If we're supposed to be extending an existing string, and that
922 ;; string really is at the front of the menu, then update it in place.
923 (if (and old (or (eq old (car front))
924 (string= old (car front))))
dfabc98f 925 (progn
3dd92899
KH
926 (setcar front string)
927 (setcar (cdr front) menu-string))
928 (setcdr yank-menu
929 (cons
930 (cons string (cons menu-string 'menu-bar-select-yank))
931 (cdr yank-menu)))))
932 (if (> (length (cdr yank-menu)) kill-ring-max)
933 (setcdr (nthcdr kill-ring-max yank-menu) nil)))
934
4cca6fbd 935(put 'menu-bar-select-yank 'apropos-inhibit t)
3dd92899
KH
936(defun menu-bar-select-yank ()
937 (interactive "*")
938 (push-mark (point))
939 (insert last-command-event))
40954111 940\f
d0690d12
RS
941(defvar list-buffers-directory nil)
942
08e8171f
RS
943(defvar menu-bar-update-buffers-maxbuf)
944
09642d97
RS
945(defun menu-bar-select-buffer ()
946 (interactive)
947 (switch-to-buffer last-command-event))
948
949(defun menu-bar-select-frame ()
950 (interactive)
951 (make-frame-visible last-command-event)
952 (raise-frame last-command-event)
953 (select-frame last-command-event))
954
c171b42f
RS
955(defun menu-bar-update-buffers-1 (elt)
956 (cons (format
08e8171f 957 (format "%%%ds %%s%%s %%s" menu-bar-update-buffers-maxbuf)
c171b42f
RS
958 (cdr elt)
959 (if (buffer-modified-p (car elt))
960 "*" " ")
961 (save-excursion
962 (set-buffer (car elt))
963 (if buffer-read-only "%" " "))
964 (let ((file
965 (or (buffer-file-name (car elt))
966 (save-excursion
967 (set-buffer (car elt))
968 list-buffers-directory)
969 "")))
970 (setq file (or (file-name-directory file)
971 ""))
972 (if (> (length file) 20)
973 (setq file (concat "..." (substring file -17))))
974 file))
975 (car elt)))
976
06ff7539
RS
977(defvar menu-bar-buffers-menu-list-buffers-entry nil)
978
09642d97 979(defun menu-bar-update-buffers ()
29397c58 980 ;; If user discards the Buffers item, play along.
4d587a6c 981 (and (lookup-key (current-global-map) [menu-bar buffer])
29397c58
RS
982 (frame-or-buffer-changed-p)
983 (let ((buffers (buffer-list))
984 (frames (frame-list))
b3398af1 985 (maxlen 0)
29397c58
RS
986 buffers-menu frames-menu)
987 ;; If requested, list only the N most recently selected buffers.
988 (if (and (integerp buffers-menu-max-size)
989 (> buffers-menu-max-size 1))
990 (if (> (length buffers) buffers-menu-max-size)
991 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
992
993 ;; Make the menu of buffers proper.
994 (setq buffers-menu
995 (cons "Select Buffer"
c171b42f
RS
996 (let* ((buffer-list
997 (mapcar 'list buffers))
998 tail
08e8171f 999 (menu-bar-update-buffers-maxbuf 0)
c171b42f
RS
1000 alist
1001 head)
1002 ;; Put into each element of buffer-list
1003 ;; the name for actual display,
1004 ;; perhaps truncated in the middle.
1005 (setq tail buffer-list)
1006 (while tail
1007 (let ((name (buffer-name (car (car tail)))))
1008 (setcdr (car tail)
1009 (if (> (length name) 27)
1010 (concat (substring name 0 12)
1011 "..."
1012 (substring name -12))
1013 name)))
1014 (setq tail (cdr tail)))
1015 ;; Compute the maximum length of any name.
1016 (setq tail buffer-list)
29397c58 1017 (while tail
c171b42f 1018 (or (eq ?\ (aref (cdr (car tail)) 0))
08e8171f
RS
1019 (setq menu-bar-update-buffers-maxbuf
1020 (max menu-bar-update-buffers-maxbuf
c171b42f 1021 (length (cdr (car tail))))))
29397c58 1022 (setq tail (cdr tail)))
c171b42f
RS
1023 ;; Set ALIST to an alist of the form
1024 ;; ITEM-STRING . BUFFER
1025 (setq tail buffer-list)
29397c58
RS
1026 (while tail
1027 (let ((elt (car tail)))
c171b42f 1028 (or (eq ?\ (aref (cdr elt) 0))
29397c58 1029 (setq alist (cons
c171b42f 1030 (menu-bar-update-buffers-1 elt)
29397c58
RS
1031 alist)))
1032 (and alist (> (length (car (car alist))) maxlen)
1033 (setq maxlen (length (car (car alist))))))
1034 (setq tail (cdr tail)))
1035 (setq alist (nreverse alist))
06ff7539
RS
1036 ;; Make the menu item for list-buffers
1037 ;; or reuse the one we already have.
1038 ;; The advantage in reusing one
1039 ;; is that it already has the keyboard equivalent
1040 ;; cached, so we save the time to look that up again.
1041 (or menu-bar-buffers-menu-list-buffers-entry
1042 (setq menu-bar-buffers-menu-list-buffers-entry
1043 (cons
1044 'list-buffers
1045 (cons
1046 ""
1047 'list-buffers))))
1048 ;; Update the item string for menu's new width.
1049 (setcar (cdr menu-bar-buffers-menu-list-buffers-entry)
1050 (concat (make-string (max (- (/ maxlen 2) 8) 0)
1051 ?\ )
1052 "List All Buffers"))
1053 ;; Now make the actual list of items,
1054 ;; ending with the list-buffers item.
f2116cf9 1055 (nconc (mapcar (lambda (pair)
10013d74
DL
1056 ;; This is somewhat risque, to use
1057 ;; the buffer name itself as the event
1058 ;; type to define, but it works.
1059 ;; It would not work to use the buffer
1060 ;; since a buffer as an event has its
1061 ;; own meaning.
1062 (nconc (list (buffer-name (cdr pair))
1063 (car pair)
1064 (cons nil nil))
1065 'menu-bar-select-buffer))
29397c58 1066 alist)
06ff7539 1067 (list menu-bar-buffers-menu-list-buffers-entry)))))
29397c58
RS
1068
1069
1070 ;; Make a Frames menu if we have more than one frame.
1071 (if (cdr frames)
b3398af1
RS
1072 (let ((name (concat (make-string (max (- (/ maxlen 2) 3) 0)
1073 ?\ )
1074 "Frames"))
1075 (frames-menu
1076 (cons 'keymap
1077 (cons "Select Frame"
10013d74
DL
1078 (mapcar
1079 (lambda (frame)
1080 (nconc
1081 (list frame
ce9561ac 1082 (frame-parameter frame 'name)
10013d74
DL
1083 (cons nil nil))
1084 'menu-bar-select-frame))
b3398af1
RS
1085 frames)))))
1086 ;; Put it underneath the Buffers menu.
1087 (setq buffers-menu (cons (cons 'frames (cons name frames-menu))
1088 buffers-menu))))
29397c58
RS
1089 (if buffers-menu
1090 (setq buffers-menu (cons 'keymap buffers-menu)))
4d587a6c 1091 (define-key (current-global-map) [menu-bar buffer]
b3398af1 1092 (cons "Buffers" buffers-menu)))))
09642d97
RS
1093
1094(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
2f1139a4 1095
3f557298
RS
1096(menu-bar-update-buffers)
1097
40954111
RS
1098;; this version is too slow
1099;;;(defun format-buffers-menu-line (buffer)
1100;;; "Returns a string to represent the given buffer in the Buffer menu.
1101;;;nil means the buffer shouldn't be listed. You can redefine this."
1102;;; (if (string-match "\\` " (buffer-name buffer))
1103;;; nil
1104;;; (save-excursion
1105;;; (set-buffer buffer)
1106;;; (let ((size (buffer-size)))
1107;;; (format "%s%s %-19s %6s %-15s %s"
1108;;; (if (buffer-modified-p) "*" " ")
1109;;; (if buffer-read-only "%" " ")
1110;;; (buffer-name)
1111;;; size
1112;;; mode-name
1113;;; (or (buffer-file-name) ""))))))
1114\f
25b048ee
RS
1115;;; Set up a menu bar menu for the minibuffer.
1116
1117(mapcar
1118 (function
1119 (lambda (map)
1120 (define-key map [menu-bar minibuf]
1121 (cons "Minibuf" (make-sparse-keymap "Minibuf")))))
1122 (list minibuffer-local-ns-map
1123 minibuffer-local-must-match-map
1124 minibuffer-local-isearch-map
1125 minibuffer-local-map
1126 minibuffer-local-completion-map))
1127
1128(mapcar
1129 (function
1130 (lambda (map)
1131 (define-key map [menu-bar minibuf ?\?]
7f315c7c
EZ
1132 (list 'menu-item "List Completions" 'minibuffer-completion-help
1133 :help "Display all possible completions"))
25b048ee 1134 (define-key map [menu-bar minibuf space]
7f315c7c
EZ
1135 (list 'menu-item "Complete Word" 'minibuffer-complete-word
1136 :help "Complete at most one word"))
25b048ee 1137 (define-key map [menu-bar minibuf tab]
7f315c7c
EZ
1138 (list 'menu-item "Complete" 'minibuffer-complete
1139 :help "Complete as far as possible"))
25b048ee
RS
1140 ))
1141 (list minibuffer-local-must-match-map
1142 minibuffer-local-completion-map))
1143
1144(mapcar
1145 (function
1146 (lambda (map)
1147 (define-key map [menu-bar minibuf quit]
7f315c7c
EZ
1148 (list 'menu-item "Quit" 'keyboard-escape-quit
1149 :help "Abort input and exit minibuffer"))
25b048ee 1150 (define-key map [menu-bar minibuf return]
7f315c7c
EZ
1151 (list 'menu-item "Enter" 'exit-minibuffer
1152 :help "Terminate input and exit minibuffer"))
25b048ee
RS
1153 ))
1154 (list minibuffer-local-ns-map
1155 minibuffer-local-must-match-map
1156 minibuffer-local-isearch-map
1157 minibuffer-local-map
1158 minibuffer-local-completion-map))
1159\f
88a26eb4
DL
1160(defcustom menu-bar-mode nil
1161 "Toggle display of a menu bar on each frame.
1162Setting this variable directly does not take effect;
1163use either \\[customize] or the function `menu-bar-mode'."
1164 :set (lambda (symbol value)
1165 (menu-bar-mode (or value 0)))
1166 :initialize 'custom-initialize-default
1167 :type 'boolean
1168 :group 'frames)
7b7d6615 1169
057d49d1 1170(defun menu-bar-mode (flag)
dfd29450 1171 "Toggle display of a menu bar on each frame.
057d49d1
RS
1172This command applies to all frames that exist and frames to be
1173created in the future.
e1d18ad8
RS
1174With a numeric argument, if the argument is positive,
1175turn on menu bars; otherwise, turn off menu bars."
dad8e392 1176 (interactive "P")
dad8e392 1177
7b7d6615
RS
1178 ;; Make menu-bar-mode and default-frame-alist consistent.
1179 (let ((default (assq 'menu-bar-lines default-frame-alist)))
1180 (if default
1181 (setq menu-bar-mode (not (eq (cdr default) 0)))
1182 (setq default-frame-alist
1183 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
1184 default-frame-alist))))
1185
1186 ;; Toggle or set the mode, according to FLAG.
1187 (setq menu-bar-mode (if (null flag) (not menu-bar-mode)
1188 (> (prefix-numeric-value flag) 0)))
1189
1190 ;; Apply it to default-frame-alist.
1191 (let ((parameter (assq 'menu-bar-lines default-frame-alist)))
1192 (if (consp parameter)
1193 (setcdr parameter (if menu-bar-mode 1 0))
1194 (setq default-frame-alist
1195 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
1196 default-frame-alist))))
1197
1198 ;; Apply it to existing frames.
1199 (let ((frames (frame-list)))
1200 (while frames
1201 (let ((height (cdr (assq 'height (frame-parameters (car frames))))))
1202 (modify-frame-parameters (car frames)
1203 (list (cons 'menu-bar-lines
1204 (if menu-bar-mode 1 0))))
1205 (modify-frame-parameters (car frames)
1206 (list (cons 'height height))))
1207 (setq frames (cdr frames)))))
1db87953 1208
bffa5d4d
RS
1209(provide 'menu-bar)
1210
235aa29b 1211;;; menu-bar.el ends here