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