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