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