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