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