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