Add 2009 to copyright years.
[bpt/emacs.git] / lisp / menu-bar.el
CommitLineData
55535639 1;;; menu-bar.el --- define a default menu bar
235aa29b 2
497f0cdd
GM
3;; Copyright (C) 1993, 1994, 1995, 2000, 2001, 2002, 2003, 2004, 2005,
4;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
b578f267 5
235aa29b 6;; Author: RMS
e4874521 7;; Maintainer: FSF
dbcee71a 8;; Keywords: internal, mouse
235aa29b 9
1db87953
RS
10;; This file is part of GNU Emacs.
11
eb3fa2cf 12;; GNU Emacs is free software: you can redistribute it and/or modify
1db87953 13;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
1db87953
RS
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
eb3fa2cf 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
1db87953 24
260130bb
KH
25;; Avishai Yacobi suggested some menu rearrangements.
26
55535639
PJ
27;;; Commentary:
28
b578f267
EN
29;;; Code:
30
b132f2b1
RM
31;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
32;; definitions made in loaddefs.el.
33(or (lookup-key global-map [menu-bar])
34 (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
22390f50 35(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
ffbdd83d
RS
36
37;; Force Help item to come last, after the major mode's own items.
0d31efcd
KH
38;; The symbol used to be called `help', but that gets confused with the
39;; help key.
40(setq menu-bar-final-items '(help-menu))
ffbdd83d 41
8f43cbf3 42(define-key global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu))
ffbdd83d 43(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
8f43cbf3 44(define-key global-map [menu-bar tools] (cons (purecopy "Tools") menu-bar-tools-menu))
7f315c7c 45;; This definition is just to show what this looks like.
bf902855
SM
46;; It gets modified in place when menu-bar-update-buffers is called.
47(defvar global-buffers-menu-map (make-sparse-keymap "Buffers"))
7f315c7c 48(define-key global-map [menu-bar buffer]
8f43cbf3 49 (cons (purecopy "Buffers") global-buffers-menu-map))
7f315c7c
EZ
50(defvar menu-bar-options-menu (make-sparse-keymap "Options"))
51(define-key global-map [menu-bar options]
8f43cbf3 52 (cons (purecopy "Options") menu-bar-options-menu))
7f315c7c 53(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
8f43cbf3 54(define-key global-map [menu-bar edit] (cons (purecopy "Edit") menu-bar-edit-menu))
b23b6fec 55(defvar menu-bar-file-menu (make-sparse-keymap "File"))
8f43cbf3 56(define-key global-map [menu-bar file] (cons (purecopy "File") menu-bar-file-menu))
1b009b97
RS
57
58;; This alias is for compatibility with 19.28 and before.
b23b6fec 59(defvar menu-bar-files-menu menu-bar-file-menu)
68703c11
MB
60
61;; This is referenced by some code below; it is defined in uniquify.el
62(defvar uniquify-buffer-name-style)
63
1becddbb
JB
64;; From emulation/cua-base.el; used below
65(defvar cua-enable-cua-keys)
66
9bb8e471 67\f
7f315c7c 68;; The "File" menu items
b23b6fec 69(define-key menu-bar-file-menu [exit-emacs]
72033dbe
DN
70 `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal
71 :help ,(purecopy "Save unsaved buffers, then exit")))
ffbdd83d 72
b23b6fec 73(define-key menu-bar-file-menu [separator-exit]
a3c20c83 74 menu-bar-separator)
ffbdd83d 75
7f315c7c
EZ
76;; Don't use delete-frame as event name because that is a special
77;; event.
b23b6fec 78(define-key menu-bar-file-menu [delete-this-frame]
72033dbe 79 `(menu-item ,(purecopy "Delete Frame") delete-frame
7f315c7c
EZ
80 :visible (fboundp 'delete-frame)
81 :enable (delete-frame-enabled-p)
72033dbe 82 :help ,(purecopy "Delete currently selected frame")))
b23b6fec 83(define-key menu-bar-file-menu [make-frame-on-display]
72033dbe 84 `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display
7f315c7c 85 :visible (fboundp 'make-frame-on-display)
72033dbe 86 :help ,(purecopy "Open a new frame on another display")))
b23b6fec 87(define-key menu-bar-file-menu [make-frame]
72033dbe 88 `(menu-item ,(purecopy "New Frame") make-frame-command
7f315c7c 89 :visible (fboundp 'make-frame-command)
72033dbe 90 :help ,(purecopy "Open a new frame")))
7f315c7c 91
b23b6fec 92(define-key menu-bar-file-menu [one-window]
72033dbe 93 `(menu-item ,(purecopy "Remove Splits") delete-other-windows
7f315c7c 94 :enable (not (one-window-p t nil))
72033dbe 95 :help ,(purecopy "Selected window grows to fill the whole frame")))
ffbdd83d 96
b23b6fec 97(define-key menu-bar-file-menu [split-window]
72033dbe 98 `(menu-item ,(purecopy "Split Window") split-window-vertically
92752c3a
EZ
99 :enable (and (menu-bar-menu-frame-live-and-visible-p)
100 (menu-bar-non-minibuffer-window-p))
72033dbe 101 :help ,(purecopy "Split selected window in two windows")))
7f315c7c 102
b23b6fec 103(define-key menu-bar-file-menu [separator-window]
a3c20c83 104 menu-bar-separator)
7f315c7c 105
b23b6fec 106(define-key menu-bar-file-menu [ps-print-region]
72033dbe 107 `(menu-item ,(purecopy "Postscript Print Region (B+W)") ps-print-region
438c2df0 108 :enable mark-active
72033dbe 109 :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer")))
b23b6fec 110(define-key menu-bar-file-menu [ps-print-buffer]
72033dbe 111 `(menu-item ,(purecopy "Postscript Print Buffer (B+W)") ps-print-buffer
92752c3a 112 :enable (menu-bar-menu-frame-live-and-visible-p)
72033dbe 113 :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer")))
b23b6fec 114(define-key menu-bar-file-menu [ps-print-region-faces]
72033dbe 115 `(menu-item ,(purecopy "Postscript Print Region") ps-print-region-with-faces
7f315c7c 116 :enable mark-active
72033dbe 117 :help ,(purecopy "Pretty-print marked region to PostScript printer")))
b23b6fec 118(define-key menu-bar-file-menu [ps-print-buffer-faces]
72033dbe 119 `(menu-item ,(purecopy "Postscript Print Buffer") ps-print-buffer-with-faces
92752c3a 120 :enable (menu-bar-menu-frame-live-and-visible-p)
72033dbe 121 :help ,(purecopy "Pretty-print current buffer to PostScript printer")))
b23b6fec 122(define-key menu-bar-file-menu [print-region]
72033dbe 123 `(menu-item ,(purecopy "Print Region") print-region
7f315c7c 124 :enable mark-active
72033dbe 125 :help ,(purecopy "Print region between mark and current position")))
b23b6fec 126(define-key menu-bar-file-menu [print-buffer]
72033dbe 127 `(menu-item ,(purecopy "Print Buffer") print-buffer
92752c3a 128 :enable (menu-bar-menu-frame-live-and-visible-p)
72033dbe 129 :help ,(purecopy "Print current buffer with page headings")))
7f315c7c 130
b23b6fec 131(define-key menu-bar-file-menu [separator-print]
a3c20c83 132 menu-bar-separator)
9bb8e471 133
b23b6fec 134(define-key menu-bar-file-menu [recover-session]
72033dbe 135 `(menu-item ,(purecopy "Recover Crashed Session") recover-session
7f315c7c 136 :enable (and auto-save-list-file-prefix
db3ca487
NF
137 (file-directory-p
138 (file-name-directory auto-save-list-file-prefix))
139 (directory-files
7f315c7c
EZ
140 (file-name-directory auto-save-list-file-prefix)
141 nil
142 (concat "\\`"
143 (regexp-quote
144 (file-name-nondirectory
145 auto-save-list-file-prefix)))
146 t))
72033dbe 147 :help ,(purecopy "Recover edits from a crashed session")))
b23b6fec 148(define-key menu-bar-file-menu [revert-buffer]
72033dbe 149 `(menu-item ,(purecopy "Revert Buffer") revert-buffer
7f315c7c
EZ
150 :enable (or revert-buffer-function
151 revert-buffer-insert-file-contents-function
59dac63b 152 (and buffer-file-number
7f315c7c
EZ
153 (or (buffer-modified-p)
154 (not (verify-visited-file-modtime
155 (current-buffer))))))
72033dbe 156 :help ,(purecopy "Re-read current buffer from its file")))
b23b6fec 157(define-key menu-bar-file-menu [write-file]
72033dbe 158 `(menu-item ,(purecopy "Save As...") write-file
92752c3a
EZ
159 :enable (and (menu-bar-menu-frame-live-and-visible-p)
160 (menu-bar-non-minibuffer-window-p))
72033dbe 161 :help ,(purecopy "Write current buffer to another file")))
b23b6fec 162(define-key menu-bar-file-menu [save-buffer]
72033dbe 163 `(menu-item ,(purecopy "Save") save-buffer
7f315c7c 164 :enable (and (buffer-modified-p)
7a98d821 165 (buffer-file-name)
92752c3a 166 (menu-bar-non-minibuffer-window-p))
72033dbe 167 :help ,(purecopy "Save current buffer to its file")))
7f315c7c 168
b23b6fec 169(define-key menu-bar-file-menu [separator-save]
a3c20c83 170 menu-bar-separator)
7f315c7c 171
7b5836c7
JD
172(defun menu-find-file-existing ()
173 "Edit the existing file FILENAME."
174 (interactive)
175 (let* ((mustmatch (not (and (fboundp 'x-uses-old-gtk-dialog)
176 (x-uses-old-gtk-dialog))))
177 (filename (car (find-file-read-args "Find file: " mustmatch))))
178 (if mustmatch
179 (find-file-existing filename)
180 (find-file filename))))
181
182
b23b6fec 183(define-key menu-bar-file-menu [kill-buffer]
72033dbe 184 `(menu-item ,(purecopy "Close") kill-this-buffer
7f315c7c 185 :enable (kill-this-buffer-enabled-p)
72033dbe 186 :help ,(purecopy "Discard (kill) current buffer")))
b23b6fec 187(define-key menu-bar-file-menu [insert-file]
72033dbe 188 `(menu-item ,(purecopy "Insert File...") insert-file
92752c3a 189 :enable (menu-bar-non-minibuffer-window-p)
72033dbe 190 :help ,(purecopy "Insert another file into current buffer")))
b23b6fec 191(define-key menu-bar-file-menu [dired]
72033dbe 192 `(menu-item ,(purecopy "Open Directory...") dired
92752c3a 193 :enable (menu-bar-non-minibuffer-window-p)
72033dbe 194 :help ,(purecopy "Read a directory, to operate on its files")))
b23b6fec 195(define-key menu-bar-file-menu [open-file]
72033dbe 196 `(menu-item ,(purecopy "Open File...") menu-find-file-existing
92752c3a 197 :enable (menu-bar-non-minibuffer-window-p)
72033dbe 198 :help ,(purecopy "Read an existing file into an Emacs buffer")))
b23b6fec 199(define-key menu-bar-file-menu [new-file]
72033dbe 200 `(menu-item ,(purecopy "Visit New File...") find-file
92752c3a 201 :enable (menu-bar-non-minibuffer-window-p)
72033dbe 202 :help ,(purecopy "Specify a new file's name, to edit the file")))
7f315c7c 203
9bb8e471 204\f
7f315c7c 205;; The "Edit" menu items
bac6e4e2
KS
206
207;; The "Edit->Search" submenu
208(defvar menu-bar-last-search-type nil
209 "Type of last non-incremental search command called from the menu.")
210
211(defun nonincremental-repeat-search-forward ()
212 "Search forward for the previous search string or regexp."
213 (interactive)
214 (cond
215 ((and (eq menu-bar-last-search-type 'string)
216 search-ring)
217 (search-forward (car search-ring)))
218 ((and (eq menu-bar-last-search-type 'regexp)
219 regexp-search-ring)
220 (re-search-forward (car regexp-search-ring)))
221 (t
222 (error "No previous search"))))
223
224(defun nonincremental-repeat-search-backward ()
225 "Search backward for the previous search string or regexp."
226 (interactive)
227 (cond
228 ((and (eq menu-bar-last-search-type 'string)
229 search-ring)
230 (search-backward (car search-ring)))
231 ((and (eq menu-bar-last-search-type 'regexp)
232 regexp-search-ring)
233 (re-search-backward (car regexp-search-ring)))
234 (t
235 (error "No previous search"))))
236
ffbdd83d
RS
237(defun nonincremental-search-forward (string)
238 "Read a string and search for it nonincrementally."
239 (interactive "sSearch for string: ")
bac6e4e2 240 (setq menu-bar-last-search-type 'string)
ffbdd83d
RS
241 (if (equal string "")
242 (search-forward (car search-ring))
243 (isearch-update-ring string nil)
244 (search-forward string)))
245
246(defun nonincremental-search-backward (string)
247 "Read a string and search backward for it nonincrementally."
248 (interactive "sSearch for string: ")
bac6e4e2 249 (setq menu-bar-last-search-type 'string)
ffbdd83d
RS
250 (if (equal string "")
251 (search-backward (car search-ring))
252 (isearch-update-ring string nil)
253 (search-backward string)))
254
255(defun nonincremental-re-search-forward (string)
256 "Read a regular expression and search for it nonincrementally."
257 (interactive "sSearch for regexp: ")
bac6e4e2 258 (setq menu-bar-last-search-type 'regexp)
ffbdd83d
RS
259 (if (equal string "")
260 (re-search-forward (car regexp-search-ring))
261 (isearch-update-ring string t)
262 (re-search-forward string)))
263
264(defun nonincremental-re-search-backward (string)
265 "Read a regular expression and search backward for it nonincrementally."
266 (interactive "sSearch for regexp: ")
bac6e4e2 267 (setq menu-bar-last-search-type 'regexp)
ffbdd83d
RS
268 (if (equal string "")
269 (re-search-backward (car regexp-search-ring))
270 (isearch-update-ring string t)
271 (re-search-backward string)))
272
bac6e4e2 273(defvar menu-bar-search-menu (make-sparse-keymap "Search"))
ffbdd83d 274
bac6e4e2
KS
275;; The Edit->Search->Incremental Search menu
276(defvar menu-bar-i-search-menu
277 (make-sparse-keymap "Incremental Search"))
278
279(define-key menu-bar-i-search-menu [isearch-backward-regexp]
72033dbe
DN
280 `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp
281 :help ,(purecopy "Search backwards for a regular expression as you type it")))
bac6e4e2 282(define-key menu-bar-i-search-menu [isearch-forward-regexp]
72033dbe
DN
283 `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp
284 :help ,(purecopy "Search forward for a regular expression as you type it")))
bac6e4e2 285(define-key menu-bar-i-search-menu [isearch-backward]
72033dbe
DN
286 `(menu-item ,(purecopy "Backward String...") isearch-backward
287 :help ,(purecopy "Search backwards for a string as you type it")))
bac6e4e2 288(define-key menu-bar-i-search-menu [isearch-forward]
72033dbe
DN
289 `(menu-item ,(purecopy "Forward String...") isearch-forward
290 :help ,(purecopy "Search forward for a string as you type it")))
7f315c7c 291
bac6e4e2 292(define-key menu-bar-search-menu [i-search]
98b9bf40 293 `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu))
bac6e4e2 294(define-key menu-bar-search-menu [separator-tag-isearch]
a3c20c83 295 menu-bar-separator)
7f315c7c 296
bac6e4e2 297(define-key menu-bar-search-menu [tags-continue]
72033dbe
DN
298 `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue
299 :help ,(purecopy "Continue last tags search operation")))
bac6e4e2 300(define-key menu-bar-search-menu [tags-srch]
72033dbe
DN
301 `(menu-item ,(purecopy "Search Tagged Files...") tags-search
302 :help ,(purecopy "Search for a regexp in all tagged files")))
bac6e4e2 303(define-key menu-bar-search-menu [separator-tag-search]
a3c20c83 304 menu-bar-separator)
ffbdd83d 305
fe74180c 306(define-key menu-bar-search-menu [repeat-search-back]
72033dbe 307 `(menu-item ,(purecopy "Repeat Backwards") nonincremental-repeat-search-backward
bac6e4e2
KS
308 :enable (or (and (eq menu-bar-last-search-type 'string)
309 search-ring)
310 (and (eq menu-bar-last-search-type 'regexp)
311 regexp-search-ring))
72033dbe 312 :help ,(purecopy "Repeat last search backwards")))
fe74180c 313(define-key menu-bar-search-menu [repeat-search-fwd]
72033dbe 314 `(menu-item ,(purecopy "Repeat Forward") nonincremental-repeat-search-forward
bac6e4e2
KS
315 :enable (or (and (eq menu-bar-last-search-type 'string)
316 search-ring)
317 (and (eq menu-bar-last-search-type 'regexp)
318 regexp-search-ring))
72033dbe 319 :help ,(purecopy "Repeat last search forward")))
bac6e4e2 320(define-key menu-bar-search-menu [separator-repeat-search]
a3c20c83 321 menu-bar-separator)
bac6e4e2
KS
322
323(define-key menu-bar-search-menu [re-search-backward]
72033dbe
DN
324 `(menu-item ,(purecopy "Regexp Backwards...") nonincremental-re-search-backward
325 :help ,(purecopy "Search backwards for a regular expression")))
bac6e4e2 326(define-key menu-bar-search-menu [re-search-forward]
72033dbe
DN
327 `(menu-item ,(purecopy "Regexp Forward...") nonincremental-re-search-forward
328 :help ,(purecopy "Search forward for a regular expression")))
bac6e4e2 329
fe74180c 330(define-key menu-bar-search-menu [search-backward]
72033dbe
DN
331 `(menu-item ,(purecopy "String Backwards...") nonincremental-search-backward
332 :help ,(purecopy "Search backwards for a string")))
fe74180c 333(define-key menu-bar-search-menu [search-forward]
72033dbe
DN
334 `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward
335 :help ,(purecopy "Search forward for a string")))
9bb8e471 336
bac6e4e2
KS
337;; The Edit->Replace submenu
338
339(defvar menu-bar-replace-menu (make-sparse-keymap "Replace"))
340
341(define-key menu-bar-replace-menu [tags-repl-continue]
72033dbe
DN
342 `(menu-item ,(purecopy "Continue Replace") tags-loop-continue
343 :help ,(purecopy "Continue last tags replace operation")))
bac6e4e2 344(define-key menu-bar-replace-menu [tags-repl]
72033dbe
DN
345 `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace
346 :help ,(purecopy "Interactively replace a regexp in all tagged files")))
bac6e4e2 347(define-key menu-bar-replace-menu [separator-replace-tags]
a3c20c83 348 menu-bar-separator)
bac6e4e2
KS
349
350(define-key menu-bar-replace-menu [query-replace-regexp]
72033dbe 351 `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp
bac6e4e2 352 :enable (not buffer-read-only)
72033dbe 353 :help ,(purecopy "Replace regular expression interactively, ask about each occurrence")))
bac6e4e2 354(define-key menu-bar-replace-menu [query-replace]
72033dbe 355 `(menu-item ,(purecopy "Replace String...") query-replace
bac6e4e2 356 :enable (not buffer-read-only)
72033dbe 357 :help ,(purecopy "Replace string interactively, ask about each occurrence")))
bac6e4e2 358
7f315c7c
EZ
359;;; Assemble the top-level Edit menu items.
360(define-key menu-bar-edit-menu [props]
72033dbe 361 `(menu-item ,(purecopy "Text Properties") facemenu-menu))
3dd92899 362
2eef02ab 363(define-key menu-bar-edit-menu [fill]
72033dbe 364 `(menu-item ,(purecopy "Fill") fill-region
2eef02ab
EZ
365 :enable (and mark-active (not buffer-read-only))
366 :help
72033dbe 367 ,(purecopy "Fill text in region to fit between left and right margin")))
2eef02ab
EZ
368
369(define-key menu-bar-edit-menu [separator-bookmark]
a3c20c83 370 menu-bar-separator)
7f315c7c
EZ
371
372(define-key menu-bar-edit-menu [bookmark]
72033dbe 373 `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map))
7f315c7c 374
7f315c7c
EZ
375(defvar menu-bar-goto-menu (make-sparse-keymap "Go To"))
376
377(define-key menu-bar-goto-menu [set-tags-name]
72033dbe
DN
378 `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table
379 :help ,(purecopy "Tell Tags commands which tag table file to use")))
7f315c7c
EZ
380
381(define-key menu-bar-goto-menu [separator-tag-file]
a3c20c83 382 menu-bar-separator)
7f315c7c
EZ
383
384(define-key menu-bar-goto-menu [apropos-tags]
72033dbe
DN
385 `(menu-item ,(purecopy "Tags Apropos...") tags-apropos
386 :help ,(purecopy "Find function/variables whose names match regexp")))
7f315c7c 387(define-key menu-bar-goto-menu [next-tag-otherw]
72033dbe 388 `(menu-item ,(purecopy "Next Tag in Other Window")
277e0f9d 389 menu-bar-next-tag-other-window
0ae27881
EZ
390 :enable (and (boundp 'tags-location-ring)
391 (not (ring-empty-p tags-location-ring)))
72033dbe 392 :help ,(purecopy "Find next function/variable matching last tag name in another window")))
277e0f9d
RS
393
394(defun menu-bar-next-tag-other-window ()
395 "Find the next definition of the tag already specified."
396 (interactive)
397 (find-tag-other-window nil t))
398
399(defun menu-bar-next-tag ()
400 "Find the next definition of the tag already specified."
401 (interactive)
402 (find-tag nil t))
403
7f315c7c 404(define-key menu-bar-goto-menu [next-tag]
72033dbe 405 `(menu-item ,(purecopy "Find Next Tag")
277e0f9d 406 menu-bar-next-tag
0ae27881
EZ
407 :enable (and (boundp 'tags-location-ring)
408 (not (ring-empty-p tags-location-ring)))
72033dbe 409 :help ,(purecopy "Find next function/variable matching last tag name")))
7f315c7c 410(define-key menu-bar-goto-menu [find-tag-otherw]
72033dbe
DN
411 `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window
412 :help ,(purecopy "Find function/variable definition in another window")))
7f315c7c 413(define-key menu-bar-goto-menu [find-tag]
72033dbe
DN
414 `(menu-item ,(purecopy "Find Tag...") find-tag
415 :help ,(purecopy "Find definition of function or variable")))
7f315c7c
EZ
416
417(define-key menu-bar-goto-menu [separator-tags]
a3c20c83 418 menu-bar-separator)
7f315c7c
EZ
419
420(define-key menu-bar-goto-menu [end-of-buf]
72033dbe 421 `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer))
7f315c7c 422(define-key menu-bar-goto-menu [beg-of-buf]
72033dbe 423 `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer))
7f315c7c 424(define-key menu-bar-goto-menu [go-to-pos]
72033dbe
DN
425 `(menu-item ,(purecopy "Goto Buffer Position...") goto-char
426 :help ,(purecopy "Read a number N and go to buffer position N")))
7f315c7c 427(define-key menu-bar-goto-menu [go-to-line]
72033dbe
DN
428 `(menu-item ,(purecopy "Goto Line...") goto-line
429 :help ,(purecopy "Read a line number and go to that line")))
7f315c7c
EZ
430
431(define-key menu-bar-edit-menu [goto]
98b9bf40 432 `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu))
7f315c7c 433
bac6e4e2 434(define-key menu-bar-edit-menu [replace]
98b9bf40 435 `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu))
bac6e4e2 436
7f315c7c 437(define-key menu-bar-edit-menu [search]
98b9bf40 438 `(menu-item ,(purecopy "Search") ,menu-bar-search-menu))
7f315c7c 439
2eef02ab 440(define-key menu-bar-edit-menu [separator-search]
a3c20c83 441 menu-bar-separator)
2eef02ab 442
496b7491 443(define-key menu-bar-edit-menu [mark-whole-buffer]
72033dbe
DN
444 `(menu-item ,(purecopy "Select All") mark-whole-buffer
445 :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy")))
7f315c7c 446(define-key menu-bar-edit-menu [clear]
72033dbe 447 `(menu-item ,(purecopy "Clear") delete-region
7f315c7c
EZ
448 :enable (and mark-active
449 (not buffer-read-only)
450 (not (mouse-region-match)))
451 :help
72033dbe 452 ,(purecopy "Delete the text in region between mark and current position")))
8f43cbf3 453(defvar yank-menu (cons (purecopy "Select Yank") nil))
3dd92899 454(fset 'yank-menu (cons 'keymap yank-menu))
b36e96c8 455(define-key menu-bar-edit-menu [paste-from-menu]
72033dbe 456 `(menu-item ,(purecopy "Paste from Kill Menu") yank-menu
b36e96c8 457 :enable (and (cdr yank-menu) (not buffer-read-only))
72033dbe 458 :help ,(purecopy "Choose a string from the kill ring and paste it")))
7f315c7c 459(define-key menu-bar-edit-menu [paste]
72033dbe 460 `(menu-item ,(purecopy "Paste") yank
a728dc59
DR
461 :enable (and (or
462 ;; Emacs compiled --without-x doesn't have
463 ;; x-selection-exists-p.
464 (and (fboundp 'x-selection-exists-p)
465 (x-selection-exists-p))
466 kill-ring)
467 (not buffer-read-only))
72033dbe 468 :help ,(purecopy "Paste (yank) text most recently cut/copied")))
7f315c7c 469(define-key menu-bar-edit-menu [copy]
72033dbe 470 `(menu-item ,(purecopy "Copy") menu-bar-kill-ring-save
7f315c7c 471 :enable mark-active
72033dbe 472 :help ,(purecopy "Copy text in region between mark and current position")
a3c20c83 473 :keys ,(purecopy "\\[kill-ring-save]")))
7f315c7c 474(define-key menu-bar-edit-menu [cut]
72033dbe 475 `(menu-item ,(purecopy "Cut") kill-region
7f315c7c 476 :enable (and mark-active (not buffer-read-only))
ae65cd84 477 :help
72033dbe 478 ,(purecopy "Cut (kill) text in region between mark and current position")))
7f315c7c 479(define-key menu-bar-edit-menu [undo]
72033dbe 480 `(menu-item ,(purecopy "Undo") undo
7f315c7c
EZ
481 :enable (and (not buffer-read-only)
482 (not (eq t buffer-undo-list))
483 (if (eq last-command 'undo)
37fec9be 484 (listp pending-undo-list)
7f315c7c 485 (consp buffer-undo-list)))
72033dbe 486 :help ,(purecopy "Undo last operation")))
7f315c7c 487
057d49d1 488
4c0317b1
RS
489(defun menu-bar-kill-ring-save (beg end)
490 (interactive "r")
491 (if (mouse-region-match)
b1a4cc61 492 (message "Selecting a region with the mouse does `copy' automatically")
4c0317b1
RS
493 (kill-ring-save beg end)))
494
f9cf0be2 495;; These are alternative definitions for the cut, paste and copy
4c0317b1 496;; menu items. Use them if your system expects these to use the clipboard.
f9cf0be2 497
c3283990
MR
498(put 'clipboard-kill-region 'menu-enable
499 '(and mark-active (not buffer-read-only)))
f9cf0be2
RS
500(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
501(put 'clipboard-yank 'menu-enable
a728dc59
DR
502 '(and (or (not (fboundp 'x-selection-exists-p))
503 (x-selection-exists-p)
c3283990 504 (x-selection-exists-p 'CLIPBOARD))
a728dc59 505 (not buffer-read-only)))
f9cf0be2
RS
506
507(defun clipboard-yank ()
ee497664 508 "Insert the clipboard contents, or the last stretch of killed text."
1d45e02e 509 (interactive "*")
f9cf0be2
RS
510 (let ((x-select-enable-clipboard t))
511 (yank)))
512
513(defun clipboard-kill-ring-save (beg end)
514 "Copy region to kill ring, and save in the X clipboard."
515 (interactive "r")
516 (let ((x-select-enable-clipboard t))
517 (kill-ring-save beg end)))
518
519(defun clipboard-kill-region (beg end)
520 "Kill the region, and save it in the X clipboard."
521 (interactive "r")
522 (let ((x-select-enable-clipboard t))
523 (kill-region beg end)))
524
525(defun menu-bar-enable-clipboard ()
5cbdeb30
RS
526 "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
527Do the same for the keys of the same name."
f9cf0be2 528 (interactive)
5754d7f2
RS
529 ;; We can't use constant list structure here because it becomes pure,
530 ;; and because it gets modified with cache data.
531 (define-key menu-bar-edit-menu [paste]
7f315c7c 532 (cons "Paste" (cons "Paste text from clipboard" 'clipboard-yank)))
5754d7f2 533 (define-key menu-bar-edit-menu [copy]
7f315c7c
EZ
534 (cons "Copy" (cons "Copy text in region to the clipboard"
535 'clipboard-kill-ring-save)))
5754d7f2 536 (define-key menu-bar-edit-menu [cut]
7f315c7c
EZ
537 (cons "Cut" (cons "Delete text in region and copy it to the clipboard"
538 'clipboard-kill-region)))
5cbdeb30 539
e3fa3057
DL
540 ;; These are Sun server keysyms for the Cut, Copy and Paste keys
541 ;; (also for XFree86 on Sun keyboard):
5cbdeb30
RS
542 (define-key global-map [f20] 'clipboard-kill-region)
543 (define-key global-map [f16] 'clipboard-kill-ring-save)
544 (define-key global-map [f18] 'clipboard-yank)
e3fa3057 545 ;; X11R6 versions:
5cbdeb30
RS
546 (define-key global-map [cut] 'clipboard-kill-region)
547 (define-key global-map [copy] 'clipboard-kill-ring-save)
548 (define-key global-map [paste] 'clipboard-yank))
f9cf0be2 549\f
7f315c7c 550;; The "Options" menu items
a9f53ffb
RS
551
552(defvar menu-bar-custom-menu (make-sparse-keymap "Customize"))
553
b0f661de 554(define-key menu-bar-custom-menu [customize-apropos-groups]
72033dbe
DN
555 `(menu-item ,(purecopy "Groups Matching Regexp...") customize-apropos-groups
556 :help ,(purecopy "Browse groups whose names match regexp")))
b0f661de 557(define-key menu-bar-custom-menu [customize-apropos-faces]
72033dbe
DN
558 `(menu-item ,(purecopy "Faces Matching Regexp...") customize-apropos-faces
559 :help ,(purecopy "Browse faces whose names match regexp")))
b0f661de 560(define-key menu-bar-custom-menu [customize-apropos-options]
72033dbe
DN
561 `(menu-item ,(purecopy "Options Matching Regexp...") customize-apropos-options
562 :help ,(purecopy "Browse options whose names match regexp")))
a9f53ffb 563(define-key menu-bar-custom-menu [customize-apropos]
72033dbe
DN
564 `(menu-item ,(purecopy "Settings Matching Regexp...") customize-apropos
565 :help ,(purecopy "Browse customizable settings whose names match regexp")))
6e0fbd65 566(define-key menu-bar-custom-menu [separator-1]
a3c20c83 567 menu-bar-separator)
c9a86e71 568(define-key menu-bar-custom-menu [customize-group]
72033dbe
DN
569 `(menu-item ,(purecopy "Specific Group...") customize-group
570 :help ,(purecopy "Customize settings of specific group")))
a9f53ffb 571(define-key menu-bar-custom-menu [customize-face]
72033dbe
DN
572 `(menu-item ,(purecopy "Specific Face...") customize-face
573 :help ,(purecopy "Customize attributes of specific face")))
b0f661de 574(define-key menu-bar-custom-menu [customize-option]
72033dbe
DN
575 `(menu-item ,(purecopy "Specific Option...") customize-option
576 :help ,(purecopy "Customize value of specific option")))
6e0fbd65 577(define-key menu-bar-custom-menu [separator-2]
a3c20c83 578 menu-bar-separator)
6fe9c658 579(define-key menu-bar-custom-menu [customize-changed-options]
72033dbe
DN
580 `(menu-item ,(purecopy "New Options...") customize-changed-options
581 :help ,(purecopy "Options added or changed in recent Emacs versions")))
6e0fbd65 582(define-key menu-bar-custom-menu [customize-saved]
72033dbe
DN
583 `(menu-item ,(purecopy "Saved Options") customize-saved
584 :help ,(purecopy "Customize previously saved options")))
b0f661de 585(define-key menu-bar-custom-menu [separator-3]
a3c20c83 586 menu-bar-separator)
e6354b3e 587(define-key menu-bar-custom-menu [customize-browse]
72033dbe
DN
588 `(menu-item ,(purecopy "Browse Customization Groups") customize-browse
589 :help ,(purecopy "Browse all customization groups")))
b0f661de 590(define-key menu-bar-custom-menu [customize]
72033dbe
DN
591 `(menu-item ,(purecopy "Top-level Customization Group") customize
592 :help ,(purecopy "The master group called `Emacs'")))
a9f53ffb 593
7f315c7c 594;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
bacb2d12 595
09bfa5ca
SM
596(defmacro menu-bar-make-mm-toggle (fname doc help &optional props)
597 "Make a menu-item for a global minor mode toggle.
598FNAME is the minor mode's name (variable and function).
7faa9d02 599DOC is the text to use for the menu entry.
09bfa5ca
SM
600HELP is the text to use for the tooltip.
601PROPS are additional properties."
8f43cbf3 602 `(list 'menu-item (purecopy ,doc) ',fname
e24f42ab 603 ,@(mapcar (lambda (p) (list 'quote p)) props)
cf4aaa59
JL
604 :help (purecopy ,help)
605 :button '(:toggle . (and (default-boundp ',fname)
606 (default-value ',fname)))))
09bfa5ca 607
a9d96061 608(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
bacb2d12 609 `(progn
da67fa9a 610 (defun ,name (&optional interactively)
e8dd28e7 611 ,(concat "Toggle whether to " (downcase (substring help 0 1))
d02c57d3 612 (substring help 1) ".
da67fa9a
RS
613In an interactive call, record this option as a candidate for saving
614by \"Save Options\" in Custom buffers.")
615 (interactive "p")
bacb2d12 616 (if ,(if body `(progn . ,body)
bc6f3791 617 `(progn
4f9b9060
PA
618 (custom-load-symbol ',variable)
619 (let ((set (or (get ',variable 'custom-set) 'set-default))
620 (get (or (get ',variable 'custom-get) 'default-value)))
621 (funcall set ',variable (not (funcall get ',variable))))))
b36e96c8
RS
622 (message ,message "enabled globally")
623 (message ,message "disabled globally"))
a9d96061
SM
624 ;; The function `customize-mark-as-set' must only be called when
625 ;; a variable is set interactively, as the purpose is to mark it as
626 ;; a candidate for "Save Options", and we do not want to save options
627 ;; the user have already set explicitly in his init file.
da67fa9a 628 (if interactively (customize-mark-as-set ',variable)))
8f43cbf3 629 (list 'menu-item (purecopy ,doc) ',name
cf4aaa59
JL
630 :help (purecopy ,help)
631 :button '(:toggle . (and (default-boundp ',variable)
632 (default-value ',variable))))))
7f315c7c 633
ba858bf9
CY
634;; Function for setting/saving default font.
635
636(defun menu-set-font ()
637 "Interactively select a font and make it the default."
638 (interactive)
2c09b70c 639 (let ((font (if (fboundp 'x-select-font)
a81a17c5 640 (x-select-font)
ba858bf9
CY
641 (mouse-select-font)))
642 spec)
643 (when font
bb712f90
CY
644 ;; Be careful here: when set-face-attribute is called for the
645 ;; :font attribute, Emacs tries to guess the best matching font
646 ;; by examining the other face attributes (Bug#2476).
647 (set-face-attribute 'default (selected-frame)
648 :width 'normal
649 :weight 'normal
650 :slant 'normal
651 :font font)
431709cb
CY
652 (let ((font-object (face-attribute 'default :font)))
653 (dolist (f (frame-list))
654 (and (not (eq f (selected-frame)))
655 (display-graphic-p f)
656 (set-face-attribute 'default f :font font-object)))
657 (set-face-attribute 'default t :font font-object))
ba858bf9
CY
658 (setq spec (list (list t (face-attr-construct 'default))))
659 (put 'default 'customized-face spec)
660 (custom-push-theme 'theme-face 'default 'user 'set spec)
661 (put 'default 'face-modified nil))))
662
7f315c7c
EZ
663;;; Assemble all the top-level items of the "Options" menu
664(define-key menu-bar-options-menu [customize]
98b9bf40 665 `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu))
10013d74
DL
666
667(defun menu-bar-options-save ()
668 "Save current values of Options menu items using Custom."
669 (interactive)
414fd702 670 (let ((need-save nil))
5373d675
RS
671 ;; These are set with menu-bar-make-mm-toggle, which does not
672 ;; put on a customized-value property.
e1573595
LK
673 (dolist (elt '(line-number-mode column-number-mode size-indication-mode
674 cua-mode show-paren-mode transient-mark-mode
dea24608 675 blink-cursor-mode display-time-mode display-battery-mode))
5373d675
RS
676 (and (customize-mark-to-save elt)
677 (setq need-save t)))
4f9b9060 678 ;; These are set with `customize-set-variable'.
5373d675 679 (dolist (elt '(scroll-bar-mode
73ae229c
NR
680 debug-on-quit debug-on-error
681 tooltip-mode menu-bar-mode tool-bar-mode
8cfa1cd5 682 save-place uniquify-buffer-name-style fringe-mode
622a8785 683 indicate-empty-lines indicate-buffer-boundaries
537fd670 684 case-fold-search
f4990970 685 current-language-environment default-input-method
4f9b9060
PA
686 ;; Saving `text-mode-hook' is somewhat questionable,
687 ;; as we might get more than we bargain for, if
688 ;; other code may has added hooks as well.
689 ;; Nonetheless, not saving it would like be confuse
690 ;; more often.
691 ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-11.
692 text-mode-hook))
693 (and (get elt 'customized-value)
694 (customize-mark-to-save elt)
695 (setq need-save t)))
e34b0c60
CY
696 (when (get 'default 'customized-face)
697 (put 'default 'saved-face (get 'default 'customized-face))
698 (put 'default 'customized-face nil)
699 (setq need-save t))
414fd702
PA
700 ;; Save if we changed anything.
701 (when need-save
702 (custom-save-all))))
10013d74
DL
703
704(define-key menu-bar-options-menu [save]
72033dbe
DN
705 `(menu-item ,(purecopy "Save Options") menu-bar-options-save
706 :help ,(purecopy "Save options set from the menu above")))
10013d74
DL
707
708(define-key menu-bar-options-menu [custom-separator]
a3c20c83 709 menu-bar-separator)
10013d74 710
ba858bf9 711(define-key menu-bar-options-menu [menu-set-font]
72033dbe 712 `(menu-item ,(purecopy "Set Default Font...") menu-set-font
ba858bf9 713 :visible (display-multi-font-p)
72033dbe 714 :help ,(purecopy "Select a default font")))
3f9f1c1f 715
c2ca4bab
PJ
716;; The "Show/Hide" submenu of menu "Options"
717
718(defvar menu-bar-showhide-menu (make-sparse-keymap "Show/Hide"))
40189bd6 719
d0e1c755 720(define-key menu-bar-showhide-menu [column-number-mode]
a9d96061 721 (menu-bar-make-mm-toggle column-number-mode
e3fa3057 722 "Column Numbers"
a9d96061 723 "Show the current column number in the mode line"))
d0e1c755
PJ
724
725(define-key menu-bar-showhide-menu [line-number-mode]
a9d96061 726 (menu-bar-make-mm-toggle line-number-mode
e3fa3057 727 "Line Numbers"
a9d96061 728 "Show the current line number in the mode line"))
d0e1c755 729
e1573595
LK
730(define-key menu-bar-showhide-menu [size-indication-mode]
731 (menu-bar-make-mm-toggle size-indication-mode
732 "Size Indication"
733 "Show the size of the buffer in the mode line"))
734
d0e1c755 735(define-key menu-bar-showhide-menu [linecolumn-separator]
a3c20c83 736 menu-bar-separator)
d0e1c755 737
87737bc2
JL
738(define-key menu-bar-showhide-menu [showhide-battery]
739 (menu-bar-make-mm-toggle display-battery-mode
1f742f74 740 "Battery Status"
87737bc2
JL
741 "Display battery status information in mode line"))
742
40189bd6 743(define-key menu-bar-showhide-menu [showhide-date-time]
4a4a82d6 744 (menu-bar-make-mm-toggle display-time-mode
704c78e9
LT
745 "Time, Load and Mail"
746 "Display time, system load averages and \
747mail status in mode line"))
40189bd6
PJ
748
749(define-key menu-bar-showhide-menu [datetime-separator]
a3c20c83 750 menu-bar-separator)
40189bd6 751
a9c6d330 752(define-key menu-bar-showhide-menu [showhide-speedbar]
72033dbe
DN
753 `(menu-item ,(purecopy "Speedbar") speedbar-frame-mode
754 :help ,(purecopy "Display a Speedbar quick-navigation frame")
a9c6d330
PA
755 :button (:toggle
756 . (and (boundp 'speedbar-frame)
757 (frame-live-p (symbol-value 'speedbar-frame))
bc6f3791 758 (frame-visible-p
a9c6d330
PA
759 (symbol-value 'speedbar-frame))))))
760
622a8785 761(defvar menu-bar-showhide-fringe-menu (make-sparse-keymap "Fringe"))
f7481749 762
622a8785
LT
763(defvar menu-bar-showhide-fringe-ind-menu
764 (make-sparse-keymap "Buffer boundaries"))
f7481749 765
622a8785
LT
766(defun menu-bar-showhide-fringe-ind-customize ()
767 "Show customization buffer for `indicate-buffer-boundaries'."
f7481749 768 (interactive)
622a8785 769 (customize-variable 'indicate-buffer-boundaries))
f7481749 770
622a8785 771(define-key menu-bar-showhide-fringe-ind-menu [customize]
72033dbe 772 `(menu-item ,(purecopy "Other (Customize)")
622a8785 773 menu-bar-showhide-fringe-ind-customize
72033dbe 774 :help ,(purecopy "Additional choices available through Custom buffer")
3a5b5d14
AS
775 :visible (display-graphic-p)
776 :button (:radio . (not (member indicate-buffer-boundaries
777 '(nil left right
778 ((top . left) (bottom . right))
779 ((t . right) (top . left))))))))
f7481749
KS
780
781(defun menu-bar-showhide-fringe-ind-mixed ()
622a8785 782 "Display top and bottom indicators in opposite fringes, arrows in right."
f7481749 783 (interactive)
622a8785
LT
784 (customize-set-variable 'indicate-buffer-boundaries
785 '((t . right) (top . left))))
f7481749
KS
786
787(define-key menu-bar-showhide-fringe-ind-menu [mixed]
72033dbe 788 `(menu-item ,(purecopy "Opposite, Arrows Right") menu-bar-showhide-fringe-ind-mixed
622a8785 789 :help
72033dbe 790 ,(purecopy "Show top/bottom indicators in opposite fringes, arrows in right")
f7481749 791 :visible (display-graphic-p)
a08404b7
AS
792 :button (:radio . (equal indicate-buffer-boundaries
793 '((t . right) (top . left))))))
f7481749
KS
794
795(defun menu-bar-showhide-fringe-ind-box ()
796 "Display top and bottom indicators in opposite fringes."
797 (interactive)
622a8785
LT
798 (customize-set-variable 'indicate-buffer-boundaries
799 '((top . left) (bottom . right))))
f7481749
KS
800
801(define-key menu-bar-showhide-fringe-ind-menu [box]
72033dbe
DN
802 `(menu-item ,(purecopy "Opposite, No Arrows") menu-bar-showhide-fringe-ind-box
803 :help ,(purecopy "Show top/bottom indicators in opposite fringes, no arrows")
f7481749 804 :visible (display-graphic-p)
a08404b7
AS
805 :button (:radio . (equal indicate-buffer-boundaries
806 '((top . left) (bottom . right))))))
f7481749
KS
807
808(defun menu-bar-showhide-fringe-ind-right ()
622a8785 809 "Display buffer boundaries and arrows in the right fringe."
f7481749 810 (interactive)
622a8785 811 (customize-set-variable 'indicate-buffer-boundaries 'right))
f7481749
KS
812
813(define-key menu-bar-showhide-fringe-ind-menu [right]
72033dbe
DN
814 `(menu-item ,(purecopy "In Right Fringe") menu-bar-showhide-fringe-ind-right
815 :help ,(purecopy "Show buffer boundaries and arrows in right fringe")
f7481749 816 :visible (display-graphic-p)
622a8785 817 :button (:radio . (eq indicate-buffer-boundaries 'right))))
f7481749
KS
818
819(defun menu-bar-showhide-fringe-ind-left ()
622a8785 820 "Display buffer boundaries and arrows in the left fringe."
f7481749 821 (interactive)
622a8785 822 (customize-set-variable 'indicate-buffer-boundaries 'left))
f7481749
KS
823
824(define-key menu-bar-showhide-fringe-ind-menu [left]
72033dbe
DN
825 `(menu-item ,(purecopy "In Left Fringe") menu-bar-showhide-fringe-ind-left
826 :help ,(purecopy "Show buffer boundaries and arrows in left fringe")
f7481749 827 :visible (display-graphic-p)
622a8785 828 :button (:radio . (eq indicate-buffer-boundaries 'left))))
f7481749
KS
829
830(defun menu-bar-showhide-fringe-ind-none ()
622a8785 831 "Do not display any buffer boundary indicators."
f7481749 832 (interactive)
622a8785 833 (customize-set-variable 'indicate-buffer-boundaries nil))
f7481749
KS
834
835(define-key menu-bar-showhide-fringe-ind-menu [none]
72033dbe
DN
836 `(menu-item ,(purecopy "No Indicators") menu-bar-showhide-fringe-ind-none
837 :help ,(purecopy "Hide all buffer boundary indicators and arrows")
f7481749 838 :visible (display-graphic-p)
622a8785 839 :button (:radio . (eq indicate-buffer-boundaries nil))))
f7481749 840
622a8785 841(define-key menu-bar-showhide-fringe-menu [showhide-fringe-ind]
98b9bf40
JL
842 `(menu-item ,(purecopy "Buffer Boundaries") ,menu-bar-showhide-fringe-ind-menu
843 :visible (display-graphic-p)
844 :help ,(purecopy "Indicate buffer boundaries in fringe")))
f7481749 845
622a8785
LT
846(define-key menu-bar-showhide-fringe-menu [indicate-empty-lines]
847 (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
1f742f74 848 "Empty Line Indicators"
622a8785 849 "Indicating of empty lines %s"
b36e96c8 850 "Indicate trailing empty lines in fringe, globally"))
8cfa1cd5
SJ
851
852(defun menu-bar-showhide-fringe-menu-customize ()
853 "Show customization buffer for `fringe-mode'."
854 (interactive)
855 (customize-variable 'fringe-mode))
856
857(define-key menu-bar-showhide-fringe-menu [customize]
72033dbe
DN
858 `(menu-item ,(purecopy "Customize Fringe") menu-bar-showhide-fringe-menu-customize
859 :help ,(purecopy "Detailed customization of fringe")
8cfa1cd5
SJ
860 :visible (display-graphic-p)))
861
862(defun menu-bar-showhide-fringe-menu-customize-reset ()
277e0f9d 863 "Reset the fringe mode: display fringes on both sides of a window."
8cfa1cd5
SJ
864 (interactive)
865 (customize-set-variable 'fringe-mode nil))
866
867(define-key menu-bar-showhide-fringe-menu [default]
72033dbe
DN
868 `(menu-item ,(purecopy "Default") menu-bar-showhide-fringe-menu-customize-reset
869 :help ,(purecopy "Default width fringe on both left and right side")
8cfa1cd5 870 :visible (display-graphic-p)
277e0f9d 871 :button (:radio . (eq fringe-mode nil))))
8cfa1cd5 872
8cfa1cd5 873(defun menu-bar-showhide-fringe-menu-customize-right ()
277e0f9d 874 "Display fringes only on the right of each window."
8cfa1cd5 875 (interactive)
00cb70dc
MB
876 (require 'fringe)
877 (customize-set-variable 'fringe-mode '(0 . nil)))
8cfa1cd5
SJ
878
879(define-key menu-bar-showhide-fringe-menu [right]
72033dbe
DN
880 `(menu-item ,(purecopy "On the Right") menu-bar-showhide-fringe-menu-customize-right
881 :help ,(purecopy "Fringe only on the right side")
8cfa1cd5 882 :visible (display-graphic-p)
277e0f9d 883 :button (:radio . (equal fringe-mode '(0 . nil)))))
8cfa1cd5 884
4c0252a5
JD
885(defun menu-bar-showhide-fringe-menu-customize-left ()
886 "Display fringes only on the left of each window."
887 (interactive)
888 (require 'fringe)
889 (customize-set-variable 'fringe-mode '(nil . 0)))
890
891(define-key menu-bar-showhide-fringe-menu [left]
72033dbe
DN
892 `(menu-item ,(purecopy "On the Left") menu-bar-showhide-fringe-menu-customize-left
893 :help ,(purecopy "Fringe only on the left side")
4c0252a5
JD
894 :visible (display-graphic-p)
895 :button (:radio . (equal fringe-mode '(nil . 0)))))
896
8cfa1cd5 897(defun menu-bar-showhide-fringe-menu-customize-disable ()
277e0f9d 898 "Do not display window fringes."
8cfa1cd5 899 (interactive)
00cb70dc
MB
900 (require 'fringe)
901 (customize-set-variable 'fringe-mode 0))
8cfa1cd5
SJ
902
903(define-key menu-bar-showhide-fringe-menu [none]
72033dbe
DN
904 `(menu-item ,(purecopy "None") menu-bar-showhide-fringe-menu-customize-disable
905 :help ,(purecopy "Turn off fringe")
8cfa1cd5 906 :visible (display-graphic-p)
277e0f9d 907 :button (:radio . (eq fringe-mode 0))))
8cfa1cd5
SJ
908
909(define-key menu-bar-showhide-menu [showhide-fringe]
98b9bf40
JL
910 `(menu-item ,(purecopy "Fringe") ,menu-bar-showhide-fringe-menu
911 :visible (display-graphic-p)))
8cfa1cd5 912
c2ca4bab
PJ
913(defvar menu-bar-showhide-scroll-bar-menu (make-sparse-keymap "Scroll-bar"))
914
c2ca4bab 915(define-key menu-bar-showhide-scroll-bar-menu [right]
72033dbe 916 `(menu-item ,(purecopy "On the Right")
277e0f9d 917 menu-bar-right-scroll-bar
72033dbe 918 :help ,(purecopy "Scroll-bar on the right side")
5f7b6438 919 :visible (display-graphic-p)
4f9b9060
PA
920 :button (:radio . (eq (cdr (assq 'vertical-scroll-bars
921 (frame-parameters))) 'right))))
277e0f9d
RS
922(defun menu-bar-right-scroll-bar ()
923 "Display scroll bars on the right of each window."
924 (interactive)
925 (customize-set-variable 'scroll-bar-mode 'right))
c2ca4bab
PJ
926
927(define-key menu-bar-showhide-scroll-bar-menu [left]
72033dbe 928 `(menu-item ,(purecopy "On the Left")
277e0f9d 929 menu-bar-left-scroll-bar
72033dbe 930 :help ,(purecopy "Scroll-bar on the left side")
5f7b6438 931 :visible (display-graphic-p)
4f9b9060
PA
932 :button (:radio . (eq (cdr (assq 'vertical-scroll-bars
933 (frame-parameters))) 'left))))
c2ca4bab 934
277e0f9d
RS
935(defun menu-bar-left-scroll-bar ()
936 "Display scroll bars on the left of each window."
937 (interactive)
0e5ddee1 938 (customize-set-variable 'scroll-bar-mode 'left))
277e0f9d 939
c2ca4bab 940(define-key menu-bar-showhide-scroll-bar-menu [none]
72033dbe 941 `(menu-item ,(purecopy "None")
277e0f9d 942 menu-bar-no-scroll-bar
72033dbe 943 :help ,(purecopy "Turn off scroll-bar")
5f7b6438 944 :visible (display-graphic-p)
4f9b9060
PA
945 :button (:radio . (eq (cdr (assq 'vertical-scroll-bars
946 (frame-parameters))) nil))))
c2ca4bab 947
277e0f9d
RS
948(defun menu-bar-no-scroll-bar ()
949 "Turn off scroll bars."
950 (interactive)
951 (customize-set-variable 'scroll-bar-mode nil))
952
c2ca4bab 953(define-key menu-bar-showhide-menu [showhide-scroll-bar]
98b9bf40
JL
954 `(menu-item ,(purecopy "Scroll-bar") ,menu-bar-showhide-scroll-bar-menu
955 :visible (display-graphic-p)))
c2ca4bab 956
73ae229c 957(define-key menu-bar-showhide-menu [showhide-tooltip-mode]
98b9bf40
JL
958 `(menu-item ,(purecopy "Tooltips") tooltip-mode
959 :help ,(purecopy "Turn tooltips on/off")
960 :visible (and (display-graphic-p) (fboundp 'x-show-tip))
961 :button (:toggle . tooltip-mode)))
73ae229c 962
09bfa5ca 963(define-key menu-bar-showhide-menu [menu-bar-mode]
72033dbe
DN
964 `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame
965 :help ,(purecopy "Turn menu-bar on/off")
6a5af08f 966 :button (:toggle . (> (frame-parameter nil 'menu-bar-lines) 0))))
c2ca4bab 967
c2ca4bab 968(define-key menu-bar-showhide-menu [showhide-tool-bar]
98b9bf40
JL
969 `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame
970 :help ,(purecopy "Turn tool-bar on/off")
971 :visible (display-graphic-p)
972 :button (:toggle . (> (frame-parameter nil 'tool-bar-lines) 0))))
c2ca4bab
PJ
973
974(define-key menu-bar-options-menu [showhide]
98b9bf40 975 `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu))
c2ca4bab
PJ
976
977(define-key menu-bar-options-menu [showhide-separator]
a3c20c83 978 menu-bar-separator)
c2ca4bab 979
7f315c7c
EZ
980(define-key menu-bar-options-menu [mule]
981 ;; It is better not to use backquote here,
982 ;; because that makes a bootstrapping problem
983 ;; if you need to recompile all the Lisp files using interpreted code.
98b9bf40 984 `(menu-item ,(purecopy "Mule (Multilingual Environment)") ,mule-menu-keymap
506c6d61
DL
985;; Most of the MULE menu actually does make sense in unibyte mode,
986;; e.g. language selection.
597e2240 987;;; :visible '(default-value 'enable-multibyte-characters)
ad9f6125 988 ))
7f315c7c
EZ
989;(setq menu-bar-final-items (cons 'mule menu-bar-final-items))
990;(define-key menu-bar-options-menu [preferences]
98b9bf40
JL
991; `(menu-item ,(purecopy "Preferences") ,menu-bar-preferences-menu
992; :help ,(purecopy "Toggle important global options")))
7f315c7c
EZ
993
994(define-key menu-bar-options-menu [mule-separator]
a3c20c83 995 menu-bar-separator)
bacb2d12
RS
996
997(define-key menu-bar-options-menu [debug-on-quit]
998 (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
e8dd28e7 999 "Enter Debugger on Quit/C-g" "Debug on Quit %s"
7f315c7c 1000 "Enter Lisp debugger when C-g is pressed"))
bacb2d12
RS
1001(define-key menu-bar-options-menu [debug-on-error]
1002 (menu-bar-make-toggle toggle-debug-on-error debug-on-error
e8dd28e7
RS
1003 "Enter Debugger on Error" "Debug on Error %s"
1004 "Enter Lisp debugger when an error is signaled"))
7f315c7c 1005(define-key menu-bar-options-menu [debugger-separator]
a3c20c83 1006 menu-bar-separator)
7faa9d02
LT
1007
1008(define-key menu-bar-options-menu [blink-cursor-mode]
1009 (menu-bar-make-mm-toggle blink-cursor-mode
1010 "Blinking Cursor"
1011 "Whether the cursor blinks (Blink Cursor mode)"))
1012(define-key menu-bar-options-menu [cursor-separator]
a3c20c83 1013 menu-bar-separator)
7faa9d02 1014
bacb2d12
RS
1015(define-key menu-bar-options-menu [save-place]
1016 (menu-bar-make-toggle toggle-save-place-globally save-place
89f1709f 1017 "Save Place in Files between Sessions"
bacb2d12 1018 "Saving place in files %s"
aef1a2e6
KF
1019 "Visit files of previous session when restarting Emacs"
1020 (require 'saveplace)
1021 ;; Do it by name, to avoid a free-variable
1022 ;; warning during byte compilation.
1023 (set-default
1024 'save-place (not (symbol-value 'save-place)))))
4f9b9060 1025
bacb2d12
RS
1026(define-key menu-bar-options-menu [uniquify]
1027 (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style
89f1709f 1028 "Use Directory Names in Buffer Names"
bacb2d12 1029 "Directory name in buffer names (uniquify) %s"
e8dd28e7 1030 "Uniquify buffer names by adding parent directory names"
bacb2d12
RS
1031 (require 'uniquify)
1032 (setq uniquify-buffer-name-style
1033 (if (not uniquify-buffer-name-style)
1034 'forward))))
4f9b9060 1035
7f315c7c 1036(define-key menu-bar-options-menu [edit-options-separator]
a3c20c83 1037 menu-bar-separator)
06753468 1038(define-key menu-bar-options-menu [cua-mode]
c960446b 1039 (menu-bar-make-mm-toggle cua-mode
1f742f74 1040 "C-x/C-c/C-v Cut and Paste (CUA)"
899481b7 1041 "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
e24f42ab
JL
1042 (:visible (or (not (boundp 'cua-enable-cua-keys))
1043 cua-enable-cua-keys))))
899481b7
KS
1044
1045(define-key menu-bar-options-menu [cua-emulation-mode]
1046 (menu-bar-make-mm-toggle cua-mode
1047 "Shift movement mark region (CUA)"
1048 "Use shifted movement keys to set and extend the region."
e24f42ab
JL
1049 (:visible (and (boundp 'cua-enable-cua-keys)
1050 (not cua-enable-cua-keys)))))
277e0f9d 1051
3f51f129
RS
1052(define-key menu-bar-options-menu [case-fold-search]
1053 (menu-bar-make-toggle toggle-case-fold-search case-fold-search
f5be22a2 1054 "Case-Insensitive Search"
b36e96c8 1055 "Case-Insensitive Search %s"
2a6c4d75 1056 "Ignore letter-case in search commands"))
277e0f9d
RS
1057
1058(defun menu-bar-text-mode-auto-fill ()
1059 (interactive)
1060 (toggle-text-mode-auto-fill)
1061 ;; This is somewhat questionable, as `text-mode-hook'
1062 ;; might have changed outside customize.
1063 ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-11.
1064 (customize-mark-as-set 'text-mode-hook))
1065
7f315c7c 1066(define-key menu-bar-options-menu [auto-fill-mode]
72033dbe 1067 `(menu-item ,(purecopy "Auto Fill in Text Modes")
277e0f9d 1068 menu-bar-text-mode-auto-fill
72033dbe 1069 :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)")
e51c889c
RS
1070 :button (:toggle . (if (listp text-mode-hook)
1071 (member 'turn-on-auto-fill text-mode-hook)
1072 (eq 'turn-on-auto-fill text-mode-hook)))))
2a6c4d75 1073
81577689
CY
1074
1075(defvar menu-bar-line-wrapping-menu (make-sparse-keymap "Line Wrapping"))
1076
81577689 1077(define-key menu-bar-line-wrapping-menu [word-wrap]
72033dbe 1078 `(menu-item ,(purecopy "Word Wrap (Visual Line mode)")
ad456027
CY
1079 (lambda ()
1080 (interactive)
1081 (unless visual-line-mode
1082 (visual-line-mode 1))
a3c20c83 1083 (message ,(purecopy "Visual-Line mode enabled")))
72033dbe 1084 :help ,(purecopy "Wrap long lines at word boundaries")
81577689
CY
1085 :button (:radio . (and (null truncate-lines)
1086 (not (truncated-partial-width-window-p))
1087 word-wrap))
ad456027
CY
1088 :visible (menu-bar-menu-frame-live-and-visible-p)))
1089
1090(define-key menu-bar-line-wrapping-menu [truncate]
72033dbe 1091 `(menu-item ,(purecopy "Truncate Long Lines")
ad456027
CY
1092 (lambda ()
1093 (interactive)
1094 (if visual-line-mode (visual-line-mode 0))
1095 (setq word-wrap nil)
1096 (toggle-truncate-lines 1))
72033dbe 1097 :help ,(purecopy "Truncate long lines at window edge")
ad456027
CY
1098 :button (:radio . (or truncate-lines
1099 (truncated-partial-width-window-p)))
81577689
CY
1100 :visible (menu-bar-menu-frame-live-and-visible-p)
1101 :enable (not (truncated-partial-width-window-p))))
1102
1103(define-key menu-bar-line-wrapping-menu [window-wrap]
72033dbe 1104 `(menu-item ,(purecopy "Wrap at Window Edge")
ad456027
CY
1105 (lambda () (interactive)
1106 (if visual-line-mode (visual-line-mode 0))
1107 (setq word-wrap nil)
1108 (if truncate-lines (toggle-truncate-lines -1)))
72033dbe 1109 :help ,(purecopy "Wrap long lines at window edge")
81577689
CY
1110 :button (:radio . (and (null truncate-lines)
1111 (not (truncated-partial-width-window-p))
1112 (not word-wrap)))
1113 :visible (menu-bar-menu-frame-live-and-visible-p)
1114 :enable (not (truncated-partial-width-window-p))))
1115
1116(define-key menu-bar-options-menu [line-wrapping]
98b9bf40 1117 `(menu-item ,(purecopy "Line Wrapping in this Buffer") ,menu-bar-line-wrapping-menu))
81577689 1118
0ac1c4cf 1119
7f315c7c 1120(define-key menu-bar-options-menu [highlight-separator]
a3c20c83 1121 menu-bar-separator)
7f315c7c 1122(define-key menu-bar-options-menu [highlight-paren-mode]
09bfa5ca
SM
1123 (menu-bar-make-mm-toggle show-paren-mode
1124 "Paren Match Highlighting"
a9d96061 1125 "Highlight matching/mismatched parentheses at cursor (Show Paren mode)"))
bacb2d12 1126(define-key menu-bar-options-menu [transient-mark-mode]
a9d96061
SM
1127 (menu-bar-make-mm-toggle transient-mark-mode
1128 "Active Region Highlighting"
1129 "Make text in active region stand out in color (Transient Mark mode)"
e24f42ab 1130 (:enable (not cua-mode))))
7f315c7c 1131
e5683624 1132\f
7f315c7c
EZ
1133;; The "Tools" menu items
1134
e4ca8f8c
EZ
1135(defun send-mail-item-name ()
1136 (let* ((known-send-mail-commands '((sendmail-user-agent . "sendmail")
1137 (mh-e-user-agent . "MH")
1138 (message-user-agent . "Gnus Message")
1139 (gnus-user-agent . "Gnus")))
1140 (name (assq mail-user-agent known-send-mail-commands)))
1141 (if name
1142 (setq name (cdr name))
1143 (setq name (symbol-name mail-user-agent))
1144 (if (string-match "\\(.+\\)-user-agent" name)
1145 (setq name (match-string 1 name))))
1146 name))
1147
0a1f9f1d
EZ
1148(defun read-mail-item-name ()
1149 (let* ((known-rmail-commands '((rmail . "RMAIL")
1150 (mh-rmail . "MH")
1151 (gnus . "Gnus")))
1152 (known (assq read-mail-command known-rmail-commands)))
1153 (if known (cdr known) (symbol-name read-mail-command))))
1154
9a3558cb
DN
1155(defvar menu-bar-games-menu (make-sparse-keymap "Games"))
1156
1157(define-key menu-bar-tools-menu [games]
98b9bf40 1158 `(menu-item ,(purecopy "Games") ,menu-bar-games-menu))
9a3558cb
DN
1159
1160(define-key menu-bar-tools-menu [separator-games]
a3c20c83 1161 menu-bar-separator)
9a3558cb
DN
1162
1163(define-key menu-bar-games-menu [zone]
72033dbe
DN
1164 `(menu-item ,(purecopy "Zone Out") zone
1165 :help ,(purecopy "Play tricks with Emacs display when Emacs is idle")))
9a3558cb 1166(define-key menu-bar-games-menu [tetris]
72033dbe
DN
1167 `(menu-item ,(purecopy "Tetris") tetris
1168 :help ,(purecopy "Falling blocks game")))
9a3558cb 1169(define-key menu-bar-games-menu [solitaire]
72033dbe
DN
1170 `(menu-item ,(purecopy "Solitaire") solitaire
1171 :help ,(purecopy "Get rid of all the stones")))
9a3558cb 1172(define-key menu-bar-games-menu [snake]
72033dbe
DN
1173 `(menu-item ,(purecopy "Snake") snake
1174 :help ,(purecopy "Move snake around avoiding collisions")))
9a3558cb 1175(define-key menu-bar-games-menu [pong]
72033dbe
DN
1176 `(menu-item ,(purecopy "Pong") pong
1177 :help ,(purecopy "Bounce the ball to your opponent")))
9a3558cb 1178(define-key menu-bar-games-menu [mult]
72033dbe
DN
1179 `(menu-item ,(purecopy "Multiplication Puzzle") mpuz
1180 :help ,(purecopy "Exercise brain with multiplication")))
9a3558cb 1181(define-key menu-bar-games-menu [life]
72033dbe
DN
1182 `(menu-item ,(purecopy "Life") life
1183 :help ,(purecopy "Watch how John Conway's cellular automaton evolves")))
9a3558cb 1184(define-key menu-bar-games-menu [hanoi]
72033dbe
DN
1185 `(menu-item ,(purecopy "Towers of Hanoi") hanoi
1186 :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs")))
9a3558cb 1187(define-key menu-bar-games-menu [gomoku]
72033dbe
DN
1188 `(menu-item ,(purecopy "Gomoku") gomoku
1189 :help ,(purecopy "Mark 5 contiguous squares (like tic-tac-toe)")))
9a3558cb 1190(define-key menu-bar-games-menu [bubbles]
72033dbe
DN
1191 `(menu-item ,(purecopy "Bubbles") bubbles
1192 :help ,(purecopy "Remove all bubbles using the fewest moves")))
9a3558cb 1193(define-key menu-bar-games-menu [black-box]
72033dbe
DN
1194 `(menu-item ,(purecopy "Blackbox") blackbox
1195 :help ,(purecopy "Find balls in a black box by shooting rays")))
9a3558cb 1196(define-key menu-bar-games-menu [adventure]
72033dbe
DN
1197 `(menu-item ,(purecopy "Adventure") dunnet
1198 :help ,(purecopy "Dunnet, a text Adventure game for Emacs")))
9a3558cb 1199(define-key menu-bar-games-menu [5x5]
72033dbe
DN
1200 `(menu-item ,(purecopy "5x5") 5x5
1201 :help ,(purecopy "Fill in all the squares on a 5x5 board")))
9a3558cb 1202
bfeee9d1
DN
1203(defvar menu-bar-encryption-decryption-menu
1204 (make-sparse-keymap "Encryption/Decryption"))
1205
1206(define-key menu-bar-tools-menu [encryption-decryption]
98b9bf40 1207 `(menu-item ,(purecopy "Encryption/Decryption") ,menu-bar-encryption-decryption-menu))
bfeee9d1
DN
1208
1209(define-key menu-bar-tools-menu [separator-encryption-decryption]
a3c20c83 1210 menu-bar-separator)
bfeee9d1
DN
1211
1212(define-key menu-bar-encryption-decryption-menu [insert-keys]
72033dbe
DN
1213 `(menu-item ,(purecopy "Insert Keys") epa-insert-keys
1214 :help ,(purecopy "Insert public keys after the current point")))
bfeee9d1
DN
1215
1216(define-key menu-bar-encryption-decryption-menu [export-keys]
72033dbe
DN
1217 `(menu-item ,(purecopy "Export Keys") epa-export-keys
1218 :help ,(purecopy "Export public keys to a file")))
bfeee9d1
DN
1219
1220(define-key menu-bar-encryption-decryption-menu [import-keys-region]
72033dbe
DN
1221 `(menu-item ,(purecopy "Import Keys from Region") epa-import-keys-region
1222 :help ,(purecopy "Import public keys from the current region")))
bfeee9d1
DN
1223
1224(define-key menu-bar-encryption-decryption-menu [import-keys]
72033dbe
DN
1225 `(menu-item ,(purecopy "Import Keys from File...") epa-import-keys
1226 :help ,(purecopy "Import public keys from a file")))
bfeee9d1
DN
1227
1228(define-key menu-bar-encryption-decryption-menu [list-keys]
72033dbe
DN
1229 `(menu-item ,(purecopy "List Keys") epa-list-keys
1230 :help ,(purecopy "Browse your public keyring")))
bfeee9d1
DN
1231
1232(define-key menu-bar-encryption-decryption-menu [separator-keys]
a3c20c83 1233 menu-bar-separator)
bfeee9d1 1234
bfeee9d1 1235(define-key menu-bar-encryption-decryption-menu [sign-region]
72033dbe
DN
1236 `(menu-item ,(purecopy "Sign Region") epa-sign-region
1237 :help ,(purecopy "Create digital signature of the current region")))
bfeee9d1 1238
bfeee9d1 1239(define-key menu-bar-encryption-decryption-menu [verify-region]
72033dbe
DN
1240 `(menu-item ,(purecopy "Verify Region") epa-verify-region
1241 :help ,(purecopy "Verify digital signature of the current region")))
bfeee9d1 1242
9a3558cb 1243(define-key menu-bar-encryption-decryption-menu [encrypt-region]
72033dbe
DN
1244 `(menu-item ,(purecopy "Encrypt Region") epa-encrypt-region
1245 :help ,(purecopy "Encrypt the current region")))
bfeee9d1
DN
1246
1247(define-key menu-bar-encryption-decryption-menu [decrypt-region]
72033dbe
DN
1248 `(menu-item ,(purecopy "Decrypt Region") epa-decrypt-region
1249 :help ,(purecopy "Decrypt the current region")))
bfeee9d1 1250
9a3558cb 1251(define-key menu-bar-encryption-decryption-menu [separator-file]
a3c20c83 1252 menu-bar-separator)
bfeee9d1 1253
9a3558cb 1254(define-key menu-bar-encryption-decryption-menu [sign-file]
72033dbe
DN
1255 `(menu-item ,(purecopy "Sign File...") epa-sign-file
1256 :help ,(purecopy "Create digital signature of a file")))
7f315c7c 1257
9a3558cb 1258(define-key menu-bar-encryption-decryption-menu [verify-file]
72033dbe
DN
1259 `(menu-item ,(purecopy "Verify File...") epa-verify-file
1260 :help ,(purecopy "Verify digital signature of a file")))
7f315c7c 1261
9a3558cb 1262(define-key menu-bar-encryption-decryption-menu [encrypt-file]
72033dbe
DN
1263 `(menu-item ,(purecopy "Encrypt File...") epa-encrypt-file
1264 :help ,(purecopy "Encrypt a file")))
7f315c7c 1265
9a3558cb 1266(define-key menu-bar-encryption-decryption-menu [decrypt-file]
72033dbe
DN
1267 `(menu-item ,(purecopy "Decrypt File...") epa-decrypt-file
1268 :help ,(purecopy "Decrypt a file")))
7f315c7c 1269
1edd6ac4 1270(define-key menu-bar-tools-menu [simple-calculator]
72033dbe
DN
1271 `(menu-item ,(purecopy "Simple Calculator") calculator
1272 :help ,(purecopy "Invoke the Emacs built-in quick calculator")))
1edd6ac4 1273(define-key menu-bar-tools-menu [calc]
72033dbe
DN
1274 `(menu-item ,(purecopy "Programmable Calculator") calc
1275 :help ,(purecopy "Invoke the Emacs built-in full scientific calculator")))
506c6d61 1276(define-key menu-bar-tools-menu [calendar]
72033dbe
DN
1277 `(menu-item ,(purecopy "Calendar") calendar
1278 :help ,(purecopy "Invoke the Emacs built-in calendar")))
9a45aa3d
EZ
1279
1280(define-key menu-bar-tools-menu [separator-net]
a3c20c83 1281 menu-bar-separator)
9a45aa3d 1282
7f315c7c 1283(define-key menu-bar-tools-menu [directory-search]
72033dbe 1284 `(menu-item ,(purecopy "Directory Search") eudc-tools-menu))
506c6d61 1285(define-key menu-bar-tools-menu [compose-mail]
497f0cdd 1286 `(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail
98b9bf40
JL
1287 :visible (and mail-user-agent (not (eq mail-user-agent 'ignore)))
1288 :help ,(purecopy "Send a mail message")))
506c6d61 1289(define-key menu-bar-tools-menu [rmail]
497f0cdd
GM
1290 `(menu-item (format "Read Mail (with %s)" (read-mail-item-name))
1291 menu-bar-read-mail
1292 :visible (and read-mail-command
1293 (not (eq read-mail-command 'ignore)))
98b9bf40 1294 :help ,(purecopy "Read your mail and reply to it")))
277e0f9d
RS
1295
1296(defun menu-bar-read-mail ()
724f328c 1297 "Read mail using `read-mail-command'."
277e0f9d
RS
1298 (interactive)
1299 (call-interactively read-mail-command))
1300
7f315c7c 1301(define-key menu-bar-tools-menu [gnus]
72033dbe
DN
1302 `(menu-item ,(purecopy "Read Net News (Gnus)") gnus
1303 :help ,(purecopy "Read network news groups")))
7f315c7c
EZ
1304
1305(define-key menu-bar-tools-menu [separator-vc]
a3c20c83 1306 menu-bar-separator)
7f315c7c 1307
eccd9bd5 1308(define-key menu-bar-tools-menu [pcl-cvs]
72033dbe 1309 `(menu-item ,(purecopy "PCL-CVS") cvs-global-menu))
dc172b73 1310(define-key menu-bar-tools-menu [vc] nil) ;Create the place for the VC menu.
7f315c7c
EZ
1311
1312(define-key menu-bar-tools-menu [separator-compare]
a3c20c83 1313 menu-bar-separator)
7f315c7c 1314
7f315c7c 1315(define-key menu-bar-tools-menu [epatch]
72033dbe 1316 `(menu-item ,(purecopy "Apply Patch") menu-bar-epatch-menu))
7f315c7c 1317(define-key menu-bar-tools-menu [ediff-merge]
72033dbe 1318 `(menu-item ,(purecopy "Merge") menu-bar-ediff-merge-menu))
7f315c7c 1319(define-key menu-bar-tools-menu [compare]
72033dbe 1320 `(menu-item ,(purecopy "Compare (Ediff)") menu-bar-ediff-menu))
7f315c7c
EZ
1321
1322(define-key menu-bar-tools-menu [separator-spell]
a3c20c83 1323 menu-bar-separator)
7f315c7c
EZ
1324
1325(define-key menu-bar-tools-menu [spell]
72033dbe 1326 `(menu-item ,(purecopy "Spell Checking") ispell-menu-map))
7f315c7c
EZ
1327
1328(define-key menu-bar-tools-menu [separator-prog]
a3c20c83 1329 menu-bar-separator)
7f315c7c 1330
ebf5c4f5
CY
1331(define-key menu-bar-tools-menu [semantic]
1332 `(menu-item ,(purecopy "Source Code Parsers (Semantic)")
1333 semantic-mode
1334 :help ,(purecopy "Toggle automatic parsing in source code buffers (Semantic mode)")
1335 :button (:toggle . (bound-and-true-p semantic-mode))))
1336
1337(define-key menu-bar-tools-menu [ede]
1338 `(menu-item ,(purecopy "Project support (EDE)")
1339 global-ede-mode
1340 :help ,(purecopy "Toggle the Emacs Development Environment (Global EDE mode)")
1341 :button (:toggle . (bound-and-true-p global-ede-mode))))
1342
7f315c7c 1343(define-key menu-bar-tools-menu [gdb]
72033dbe
DN
1344 `(menu-item ,(purecopy "Debugger (GDB)...") gdb
1345 :help ,(purecopy "Debug a program from within Emacs with GDB")))
7f315c7c 1346(define-key menu-bar-tools-menu [shell-on-region]
72033dbe 1347 `(menu-item ,(purecopy "Shell Command on Region...") shell-command-on-region
7f315c7c 1348 :enable mark-active
72033dbe 1349 :help ,(purecopy "Pass marked region to a shell command")))
7f315c7c 1350(define-key menu-bar-tools-menu [shell]
72033dbe
DN
1351 `(menu-item ,(purecopy "Shell Command...") shell-command
1352 :help ,(purecopy "Invoke a shell command and catch its output")))
7f315c7c 1353(define-key menu-bar-tools-menu [compile]
72033dbe
DN
1354 `(menu-item ,(purecopy "Compile...") compile
1355 :help ,(purecopy "Invoke compiler or Make, view compilation errors")))
7f315c7c 1356(define-key menu-bar-tools-menu [grep]
72033dbe
DN
1357 `(menu-item ,(purecopy "Search Files (Grep)...") grep
1358 :help ,(purecopy "Search files for strings or regexps (with Grep)")))
7f315c7c
EZ
1359
1360\f
1361;; The "Help" menu items
1362
e5683624
RS
1363(defvar menu-bar-describe-menu (make-sparse-keymap "Describe"))
1364
7f315c7c 1365(define-key menu-bar-describe-menu [mule-diag]
72033dbe 1366 `(menu-item ,(purecopy "Show All of Mule Status") mule-diag
597e2240 1367 :visible (default-value 'enable-multibyte-characters)
72033dbe 1368 :help ,(purecopy "Display multilingual environment settings")))
df5bde6d 1369(define-key menu-bar-describe-menu [describe-coding-system-briefly]
72033dbe 1370 `(menu-item ,(purecopy "Describe Coding System (Briefly)")
df5bde6d 1371 describe-current-coding-system-briefly
597e2240 1372 :visible (default-value 'enable-multibyte-characters)))
7f315c7c 1373(define-key menu-bar-describe-menu [describe-coding-system]
72033dbe 1374 `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system
597e2240 1375 :visible (default-value 'enable-multibyte-characters)))
7f315c7c 1376(define-key menu-bar-describe-menu [describe-input-method]
72033dbe 1377 `(menu-item ,(purecopy "Describe Input Method...") describe-input-method
597e2240 1378 :visible (default-value 'enable-multibyte-characters)
72033dbe 1379 :help ,(purecopy "Keyboard layout for specific input method")))
7f315c7c 1380(define-key menu-bar-describe-menu [describe-language-environment]
72033dbe 1381 `(menu-item ,(purecopy "Describe Language Environment")
98b9bf40 1382 ,describe-language-environment-map))
7f315c7c
EZ
1383
1384(define-key menu-bar-describe-menu [separator-desc-mule]
a3c20c83 1385 menu-bar-separator)
7f315c7c
EZ
1386
1387(define-key menu-bar-describe-menu [list-keybindings]
72033dbe
DN
1388 `(menu-item ,(purecopy "List Key Bindings") describe-bindings
1389 :help ,(purecopy "Display all current key bindings (keyboard shortcuts)")))
df5bde6d 1390(define-key menu-bar-describe-menu [describe-current-display-table]
72033dbe
DN
1391 `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table
1392 :help ,(purecopy "Describe the current display table")))
df5bde6d 1393(define-key menu-bar-describe-menu [describe-face]
72033dbe
DN
1394 `(menu-item ,(purecopy "Describe Face...") describe-face
1395 :help ,(purecopy "Display the properties of a face")))
e5683624 1396(define-key menu-bar-describe-menu [describe-variable]
72033dbe
DN
1397 `(menu-item ,(purecopy "Describe Variable...") describe-variable
1398 :help ,(purecopy "Display documentation of variable/option")))
e5683624 1399(define-key menu-bar-describe-menu [describe-function]
72033dbe
DN
1400 `(menu-item ,(purecopy "Describe Function...") describe-function
1401 :help ,(purecopy "Display documentation of function/command")))
686e63b3 1402(define-key menu-bar-describe-menu [describe-key-1]
72033dbe 1403 `(menu-item ,(purecopy "Describe Key or Mouse Operation...") describe-key
506c6d61 1404 ;; Users typically don't identify keys and menu items...
72033dbe
DN
1405 :help ,(purecopy "Display documentation of command bound to a \
1406key, a click, or a menu-item")))
df5bde6d 1407(define-key menu-bar-describe-menu [describe-mode]
72033dbe
DN
1408 `(menu-item ,(purecopy "Describe Buffer Modes") describe-mode
1409 :help ,(purecopy "Describe this buffer's major and minor mode")))
df5bde6d 1410
9f3bfa54
EZ
1411(defvar menu-bar-search-documentation-menu
1412 (make-sparse-keymap "Search Documentation"))
5275d6a8
EZ
1413(defun menu-bar-read-lispref ()
1414 "Display the Emacs Lisp Reference manual in Info mode."
1415 (interactive)
1416 (info "elisp"))
1417
1418(defun menu-bar-read-lispintro ()
1419 "Display the Introduction to Emacs Lisp Programming in Info mode."
1420 (interactive)
1421 (info "eintr"))
1422
5275d6a8
EZ
1423(defun search-emacs-glossary ()
1424 "Display the Glossary node of the Emacs manual in Info mode."
1425 (interactive)
1426 (info "(emacs)Glossary"))
1427
1428(defun emacs-index-search (topic)
1429 "Look up TOPIC in the indices of the Emacs User Manual."
1430 (interactive "sSubject to look up: ")
1431 (info "emacs")
1432 (Info-index topic))
1433
1434(defun elisp-index-search (topic)
1435 "Look up TOPIC in the indices of the Emacs Lisp Reference Manual."
1436 (interactive "sSubject to look up: ")
1437 (info "elisp")
1438 (Info-index topic))
df5bde6d 1439
9f3bfa54 1440(define-key menu-bar-search-documentation-menu [search-documentation-strings]
72033dbe 1441 `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation
5275d6a8 1442 :help
72033dbe 1443 ,(purecopy "Find functions and variables whose doc strings match a regexp")))
9f3bfa54 1444(define-key menu-bar-search-documentation-menu [find-any-object-by-name]
72033dbe
DN
1445 `(menu-item ,(purecopy "Find Any Object by Name...") apropos
1446 :help ,(purecopy "Find symbols of any kind whose names match a regexp")))
9f3bfa54 1447(define-key menu-bar-search-documentation-menu [find-option-by-value]
72033dbe
DN
1448 `(menu-item ,(purecopy "Find Options by Value...") apropos-value
1449 :help ,(purecopy "Find variables whose values match a regexp")))
9f3bfa54 1450(define-key menu-bar-search-documentation-menu [find-options-by-name]
72033dbe
DN
1451 `(menu-item ,(purecopy "Find Options by Name...") apropos-variable
1452 :help ,(purecopy "Find variables whose names match a regexp")))
9f3bfa54 1453(define-key menu-bar-search-documentation-menu [find-commands-by-name]
72033dbe
DN
1454 `(menu-item ,(purecopy "Find Commands by Name...") apropos-command
1455 :help ,(purecopy "Find commands whose names match a regexp")))
9f3bfa54 1456(define-key menu-bar-search-documentation-menu [sep1]
a3c20c83 1457 menu-bar-separator)
9f3bfa54 1458(define-key menu-bar-search-documentation-menu [lookup-command-in-manual]
72033dbe
DN
1459 `(menu-item ,(purecopy "Look Up Command in User Manual...") Info-goto-emacs-command-node
1460 :help ,(purecopy "Display manual section that describes a command")))
9f3bfa54 1461(define-key menu-bar-search-documentation-menu [lookup-key-in-manual]
72033dbe
DN
1462 `(menu-item ,(purecopy "Look Up Key in User Manual...") Info-goto-emacs-key-command-node
1463 :help ,(purecopy "Display manual section that describes a key")))
9f3bfa54 1464(define-key menu-bar-search-documentation-menu [lookup-subject-in-elisp-manual]
72033dbe
DN
1465 `(menu-item ,(purecopy "Look Up Subject in ELisp Manual...") elisp-index-search
1466 :help ,(purecopy "Find description of a subject in Emacs Lisp manual")))
9f3bfa54 1467(define-key menu-bar-search-documentation-menu [lookup-subject-in-emacs-manual]
72033dbe
DN
1468 `(menu-item ,(purecopy "Look Up Subject in User Manual...") emacs-index-search
1469 :help ,(purecopy "Find description of a subject in Emacs User manual")))
9f3bfa54 1470(define-key menu-bar-search-documentation-menu [emacs-terminology]
72033dbe
DN
1471 `(menu-item ,(purecopy "Emacs Terminology") search-emacs-glossary
1472 :help ,(purecopy "Display the Glossary section of the Emacs manual")))
5275d6a8
EZ
1473
1474(defvar menu-bar-manuals-menu (make-sparse-keymap "More Manuals"))
e5683624
RS
1475
1476(define-key menu-bar-manuals-menu [man]
72033dbe
DN
1477 `(menu-item ,(purecopy "Read Man Page...") manual-entry
1478 :help ,(purecopy "Man-page docs for external commands and libraries")))
e5683624 1479(define-key menu-bar-manuals-menu [sep2]
a3c20c83 1480 menu-bar-separator)
5275d6a8 1481(define-key menu-bar-manuals-menu [order-emacs-manuals]
72033dbe
DN
1482 `(menu-item ,(purecopy "Ordering Manuals") view-order-manuals
1483 :help ,(purecopy "How to order manuals from the Free Software Foundation")))
9f3bfa54 1484(define-key menu-bar-manuals-menu [lookup-subject-in-all-manuals]
72033dbe
DN
1485 `(menu-item ,(purecopy "Lookup Subject in all Manuals...") info-apropos
1486 :help ,(purecopy "Find description of a subject in all installed manuals")))
9f3bfa54 1487(define-key menu-bar-manuals-menu [other-manuals]
72033dbe
DN
1488 `(menu-item ,(purecopy "All Other Manuals (Info)") Info-directory
1489 :help ,(purecopy "Read any of the installed manuals")))
9f3bfa54 1490(define-key menu-bar-manuals-menu [emacs-lisp-reference]
72033dbe
DN
1491 `(menu-item ,(purecopy "Emacs Lisp Reference") menu-bar-read-lispref
1492 :help ,(purecopy "Read the Emacs Lisp Reference manual")))
9f3bfa54 1493(define-key menu-bar-manuals-menu [emac-lisp-intro]
72033dbe
DN
1494 `(menu-item ,(purecopy "Introduction to Emacs Lisp") menu-bar-read-lispintro
1495 :help ,(purecopy "Read the Introduction to Emacs Lisp Programming")))
bacb2d12 1496
a064691f 1497(define-key menu-bar-help-menu [about-gnu-project]
72033dbe
DN
1498 `(menu-item ,(purecopy "About GNU") describe-gnu-project
1499 :help ,(purecopy "About the GNU System, GNU Project, and GNU/Linux")))
a064691f 1500(define-key menu-bar-help-menu [about-emacs]
72033dbe
DN
1501 `(menu-item ,(purecopy "About Emacs") about-emacs
1502 :help ,(purecopy "Display version number, copyright info, and basic help")))
5275d6a8 1503(define-key menu-bar-help-menu [sep4]
a3c20c83 1504 menu-bar-separator)
f3e1e0dd 1505(define-key menu-bar-help-menu [describe-no-warranty]
72033dbe
DN
1506 `(menu-item ,(purecopy "(Non)Warranty") describe-no-warranty
1507 :help ,(purecopy "Explain that Emacs has NO WARRANTY")))
f3e1e0dd 1508(define-key menu-bar-help-menu [describe-copying]
72033dbe
DN
1509 `(menu-item ,(purecopy "Copying Conditions") describe-copying
1510 :help ,(purecopy "Show the Emacs license (GPL)")))
9f3bfa54 1511(define-key menu-bar-help-menu [getting-new-versions]
72033dbe
DN
1512 `(menu-item ,(purecopy "Getting New Versions") describe-distribution
1513 :help ,(purecopy "How to get the latest version of Emacs")))
277e0f9d
RS
1514(defun menu-bar-help-extra-packages ()
1515 "Display help about some additional packages available for Emacs."
1516 (interactive)
1517 (let (enable-local-variables)
1518 (view-file (expand-file-name "MORE.STUFF"
1519 data-directory))
4fd8fd32 1520 (goto-address-mode 1)))
e5683624 1521(define-key menu-bar-help-menu [sep2]
a3c20c83 1522 menu-bar-separator)
a064691f 1523(define-key menu-bar-help-menu [external-packages]
72033dbe
DN
1524 `(menu-item ,(purecopy "External Packages") menu-bar-help-extra-packages
1525 :help ,(purecopy "Lisp packages distributed separately for use in Emacs")))
9f3bfa54 1526(define-key menu-bar-help-menu [find-emacs-packages]
72033dbe
DN
1527 `(menu-item ,(purecopy "Find Emacs Packages") finder-by-keyword
1528 :help ,(purecopy "Find packages and features by keyword")))
9f3bfa54 1529(define-key menu-bar-help-menu [more-manuals]
98b9bf40 1530 `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu))
5275d6a8 1531(define-key menu-bar-help-menu [emacs-manual]
72033dbe
DN
1532 `(menu-item ,(purecopy "Read the Emacs Manual") info-emacs-manual
1533 :help ,(purecopy "Full documentation of Emacs features")))
e5683624 1534(define-key menu-bar-help-menu [describe]
98b9bf40 1535 `(menu-item ,(purecopy "Describe") ,menu-bar-describe-menu))
9f3bfa54 1536(define-key menu-bar-help-menu [search-documentation]
98b9bf40 1537 `(menu-item ,(purecopy "Search Documentation") ,menu-bar-search-documentation-menu))
e5683624 1538(define-key menu-bar-help-menu [sep1]
a3c20c83 1539 menu-bar-separator)
a064691f 1540(define-key menu-bar-help-menu [emacs-psychotherapist]
72033dbe
DN
1541 `(menu-item ,(purecopy "Emacs Psychotherapist") doctor
1542 :help ,(purecopy "Our doctor will help you feel better")))
9f3bfa54 1543(define-key menu-bar-help-menu [send-emacs-bug-report]
72033dbe
DN
1544 `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug
1545 :help ,(purecopy "Send e-mail to Emacs maintainers")))
9f3bfa54 1546(define-key menu-bar-help-menu [emacs-known-problems]
72033dbe
DN
1547 `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems
1548 :help ,(purecopy "Read about known problems with Emacs")))
7f315c7c 1549(define-key menu-bar-help-menu [emacs-news]
72033dbe
DN
1550 `(menu-item ,(purecopy "Emacs News") view-emacs-news
1551 :help ,(purecopy "New features of this version")))
7f315c7c 1552(define-key menu-bar-help-menu [emacs-faq]
72033dbe
DN
1553 `(menu-item ,(purecopy "Emacs FAQ") view-emacs-FAQ
1554 :help ,(purecopy "Frequently asked (and answered) questions about Emacs")))
277e0f9d
RS
1555
1556(defun help-with-tutorial-spec-language ()
1557 "Use the Emacs tutorial, specifying which language you want."
f1180544 1558 (interactive)
277e0f9d
RS
1559 (help-with-tutorial t))
1560
451ec4e3 1561(define-key menu-bar-help-menu [emacs-tutorial-language-specific]
72033dbe 1562 `(menu-item ,(purecopy "Emacs Tutorial (choose language)...")
277e0f9d 1563 help-with-tutorial-spec-language
72033dbe 1564 :help ,(purecopy "Learn how to use Emacs (choose a language)")))
7f315c7c 1565(define-key menu-bar-help-menu [emacs-tutorial]
72033dbe
DN
1566 `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial
1567 :help ,(purecopy "Learn how to use Emacs")))
889560ed 1568
92752c3a
EZ
1569(defun menu-bar-menu-frame-live-and-visible-p ()
1570 "Return non-nil if the menu frame is alive and visible.
1571The menu frame is the frame for which we are updating the menu."
55d42133 1572 (let ((menu-frame (or menu-updating-frame (selected-frame))))
92752c3a
EZ
1573 (and (frame-live-p menu-frame)
1574 (frame-visible-p menu-frame))))
1575
1576(defun menu-bar-non-minibuffer-window-p ()
1577 "Return non-nil if selected window of the menu frame is not a minibuf window.
1578
1579See the documentation of `menu-bar-menu-frame-live-and-visible-p'
1580for the definition of the menu frame."
55d42133 1581 (let ((menu-frame (or menu-updating-frame (selected-frame))))
92752c3a
EZ
1582 (not (window-minibuffer-p (frame-selected-window menu-frame)))))
1583
6eee5abf 1584(defun kill-this-buffer () ; for the menu bar
a86b330f
JL
1585 "Kill the current buffer.
1586When called in the minibuffer, get out of the minibuffer
1587using `abort-recursive-edit'."
db774a16 1588 (interactive)
a86b330f
JL
1589 (if (menu-bar-non-minibuffer-window-p)
1590 (kill-buffer (current-buffer))
1591 (abort-recursive-edit)))
db774a16 1592
2f1139a4
RS
1593(defun kill-this-buffer-enabled-p ()
1594 (let ((count 0)
1595 (buffers (buffer-list)))
1596 (while buffers
1597 (or (string-match "^ " (buffer-name (car buffers)))
1598 (setq count (1+ count)))
1599 (setq buffers (cdr buffers)))
a86b330f
JL
1600 (or (not (menu-bar-non-minibuffer-window-p))
1601 (> count 1))))
1f50590a 1602
92752c3a 1603(put 'dired 'menu-enable '(menu-bar-non-minibuffer-window-p))
1f50590a 1604
a0213a97 1605;; Permit deleting frame if it would leave a visible or iconified frame.
82a74107
KH
1606(defun delete-frame-enabled-p ()
1607 "Return non-nil if `delete-frame' should be enabled in the menu bar."
1608 (let ((frames (frame-list))
27aa8132
RS
1609 (count 0))
1610 (while frames
1611 (if (frame-visible-p (car frames))
1612 (setq count (1+ count)))
1613 (setq frames (cdr frames)))
1614 (> count 1)))
2f1139a4 1615
30e19aee 1616(defcustom yank-menu-length 20
9201cc28 1617 "Maximum length to display in the yank-menu."
30e19aee 1618 :type 'integer
d3434a5b 1619 :group 'menu)
3dd92899
KH
1620
1621(defun menu-bar-update-yank-menu (string old)
1622 (let ((front (car (cdr yank-menu)))
1623 (menu-string (if (<= (length string) yank-menu-length)
1624 string
c3e1d435
RS
1625 (concat
1626 (substring string 0 (/ yank-menu-length 2))
1627 "..."
1628 (substring string (- (/ yank-menu-length 2)))))))
7c70a955
RS
1629 ;; Don't let the menu string be all dashes
1630 ;; because that has a special meaning in a menu.
1631 (if (string-match "\\`-+\\'" menu-string)
1632 (setq menu-string (concat menu-string " ")))
3dd92899
KH
1633 ;; If we're supposed to be extending an existing string, and that
1634 ;; string really is at the front of the menu, then update it in place.
1635 (if (and old (or (eq old (car front))
1636 (string= old (car front))))
dfabc98f 1637 (progn
3dd92899
KH
1638 (setcar front string)
1639 (setcar (cdr front) menu-string))
1640 (setcdr yank-menu
1641 (cons
1642 (cons string (cons menu-string 'menu-bar-select-yank))
1643 (cdr yank-menu)))))
1644 (if (> (length (cdr yank-menu)) kill-ring-max)
1645 (setcdr (nthcdr kill-ring-max yank-menu) nil)))
1646
4cca6fbd 1647(put 'menu-bar-select-yank 'apropos-inhibit t)
3dd92899 1648(defun menu-bar-select-yank ()
5fb64ecc
EZ
1649 "Insert the stretch of previously-killed text selected from menu.
1650The menu shows all the killed text sequences stored in `kill-ring'."
3dd92899
KH
1651 (interactive "*")
1652 (push-mark (point))
1653 (insert last-command-event))
68310f2a 1654
40954111 1655\f
d3434a5b
JL
1656;;; Buffers Menu
1657
1658(defcustom buffers-menu-max-size 10
9201cc28 1659 "Maximum number of entries which may appear on the Buffers menu.
d3434a5b
JL
1660If this is 10, then only the ten most-recently-selected buffers are shown.
1661If this is nil, then all buffers are shown.
1662A large number or nil slows down menu responsiveness."
1663 :type '(choice integer
1664 (const :tag "All" nil))
1665 :group 'menu)
1666
1667(defcustom buffers-menu-buffer-name-length 30
9201cc28 1668 "Maximum length of the buffer name on the Buffers menu.
d3434a5b
JL
1669If this is a number, then buffer names are truncated to this length.
1670If this is nil, then buffer names are shown in full.
1671A large number or nil makes the menu too wide."
1672 :type '(choice integer
1673 (const :tag "Full length" nil))
1674 :group 'menu)
1675
68310f2a
MB
1676(defcustom buffers-menu-show-directories 'unless-uniquify
1677 "If non-nil, show directories in the Buffers menu for buffers that have them.
1678The special value `unless-uniquify' means that directories will be shown
1679unless `uniquify-buffer-name-style' is non-nil (in which case, buffer
1680names should include enough of a buffer's directory to distinguish it
1681from other buffers).
1682
1683Setting this variable directly does not take effect until next time the
1684Buffers menu is regenerated."
1685 :set (lambda (symbol value)
1686 (set symbol value)
1687 (menu-bar-update-buffers t))
1688 :initialize 'custom-initialize-default
1689 :type '(choice (const :tag "Never" nil)
1690 (const :tag "Unless uniquify is enabled" unless-uniquify)
1691 (const :tag "Always" t))
1692 :group 'menu)
1693
1694(defcustom buffers-menu-show-status t
1695 "If non-nil, show modified/read-only status of buffers in the Buffers menu.
1696Setting this variable directly does not take effect until next time the
1697Buffers menu is regenerated."
1698 :set (lambda (symbol value)
1699 (set symbol value)
1700 (menu-bar-update-buffers t))
1701 :initialize 'custom-initialize-default
1702 :type 'boolean
1703 :group 'menu)
1704
11ee8d90 1705(defvar list-buffers-directory nil
8f75f2da 1706 "String to display in buffer listings for buffers not visiting a file.")
11ee8d90 1707(make-variable-buffer-local 'list-buffers-directory)
d0690d12 1708
fb75de8f
VJL
1709(defun menu-bar-select-buffer ()
1710 (interactive)
1711 (switch-to-buffer last-command-event))
1712
ed10603b
SM
1713(defun menu-bar-select-frame (frame)
1714 (make-frame-visible frame)
1715 (raise-frame frame)
1716 (select-frame frame))
09642d97 1717
c171b42f 1718(defun menu-bar-update-buffers-1 (elt)
68703c11
MB
1719 (let* ((buf (car elt))
1720 (file
68310f2a
MB
1721 (and (if (eq buffers-menu-show-directories 'unless-uniquify)
1722 (or (not (boundp 'uniquify-buffer-name-style))
1723 (null uniquify-buffer-name-style))
1724 buffers-menu-show-directories)
68703c11 1725 (or (buffer-file-name buf)
68310f2a 1726 (buffer-local-value 'list-buffers-directory buf)))))
68703c11
MB
1727 (when file
1728 (setq file (file-name-directory file)))
1729 (when (and file (> (length file) 20))
1730 (setq file (concat "..." (substring file -17))))
68310f2a
MB
1731 (cons (if buffers-menu-show-status
1732 (let ((mod (if (buffer-modified-p buf) "*" ""))
1733 (ro (if (buffer-local-value 'buffer-read-only buf) "%" "")))
1734 (if file
1735 (format "%s %s%s -- %s" (cdr elt) mod ro file)
1736 (format "%s %s%s" (cdr elt) mod ro)))
1737 (if file
1738 (format "%s -- %s" (cdr elt) file)
1739 (cdr elt)))
68703c11
MB
1740 buf)))
1741
887d3c94
MB
1742;; Used to cache the menu entries for commands in the Buffers menu
1743(defvar menu-bar-buffers-menu-command-entries nil)
1744
ee1dbceb 1745(defun menu-bar-update-buffers (&optional force)
29397c58 1746 ;; If user discards the Buffers item, play along.
4d587a6c 1747 (and (lookup-key (current-global-map) [menu-bar buffer])
ee1dbceb 1748 (or force (frame-or-buffer-changed-p))
29397c58
RS
1749 (let ((buffers (buffer-list))
1750 (frames (frame-list))
bf902855 1751 buffers-menu)
29397c58
RS
1752 ;; If requested, list only the N most recently selected buffers.
1753 (if (and (integerp buffers-menu-max-size)
1754 (> buffers-menu-max-size 1))
1755 (if (> (length buffers) buffers-menu-max-size)
1756 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
1757
1758 ;; Make the menu of buffers proper.
1759 (setq buffers-menu
ed10603b 1760 (let (alist)
8b621d39
MB
1761 ;; Put into each element of buffer-list
1762 ;; the name for actual display,
1763 ;; perhaps truncated in the middle.
ed10603b
SM
1764 (dolist (buf buffers)
1765 (let ((name (buffer-name buf)))
1766 (unless (eq ?\s (aref name 0))
1767 (push (menu-bar-update-buffers-1
1768 (cons buf
d3434a5b
JL
1769 (if (and (integerp buffers-menu-buffer-name-length)
1770 (> (length name) buffers-menu-buffer-name-length))
1771 (concat
1772 (substring
1773 name 0 (/ buffers-menu-buffer-name-length 2))
1774 "..."
1775 (substring
1776 name (- (/ buffers-menu-buffer-name-length 2))))
1777 name)
1778 ))
ed10603b
SM
1779 alist))))
1780 ;; Now make the actual list of items.
1781 (let ((buffers-vec (make-vector (length alist) nil))
1782 (i (length alist)))
1783 (dolist (pair alist)
1784 (setq i (1- i))
1785 (aset buffers-vec i
1786 (nconc (list (car pair)
8b621d39 1787 (cons nil nil))
ed10603b
SM
1788 `(lambda ()
1789 (interactive)
1790 (switch-to-buffer ,(cdr pair))))))
1791 (list buffers-vec))))
29397c58
RS
1792
1793 ;; Make a Frames menu if we have more than one frame.
8b621d39 1794 (when (cdr frames)
ed10603b
SM
1795 (let* ((frames-vec (make-vector (length frames) nil))
1796 (frames-menu
1797 (cons 'keymap
1798 (list "Select Frame" frames-vec)))
1799 (i 0))
1800 (dolist (frame frames)
1801 (aset frames-vec i
1802 (nconc
1803 (list
1804 (frame-parameter frame 'name)
1805 (cons nil nil))
1806 `(lambda ()
1807 (interactive) (menu-bar-select-frame ,frame))))
1808 (setq i (1+ i)))
8b621d39
MB
1809 ;; Put it after the normal buffers
1810 (setq buffers-menu
1811 (nconc buffers-menu
1812 `((frames-separator "--")
1813 (frames menu-item "Frames" ,frames-menu))))))
1814
887d3c94
MB
1815 ;; Add in some normal commands at the end of the menu. We use
1816 ;; the copy cached in `menu-bar-buffers-menu-command-entries'
1817 ;; if it's been set already. Note that we can't use constant
1818 ;; lists for the menu-entries, because the low-level menu-code
1819 ;; modifies them.
1820 (unless menu-bar-buffers-menu-command-entries
1821 (setq menu-bar-buffers-menu-command-entries
1822 (list '(command-separator "--")
332b907c
RS
1823 (list 'next-buffer
1824 'menu-item
1825 "Next Buffer"
1826 'next-buffer
1827 :help "Switch to the \"next\" buffer in a cyclic order")
a74f9094 1828 (list 'previous-buffer
332b907c
RS
1829 'menu-item
1830 "Previous Buffer"
a74f9094 1831 'previous-buffer
332b907c 1832 :help "Switch to the \"previous\" buffer in a cyclic order")
887d3c94
MB
1833 (list 'select-named-buffer
1834 'menu-item
1835 "Select Named Buffer..."
1836 'switch-to-buffer
1837 :help "Prompt for a buffer name, and select that buffer in the current window")
1838 (list 'list-all-buffers
1839 'menu-item
1840 "List All Buffers"
1841 'list-buffers
4f00f90f 1842 :help "Pop up a window listing all Emacs buffers"
887d3c94 1843 ))))
8b621d39 1844 (setq buffers-menu
887d3c94 1845 (nconc buffers-menu menu-bar-buffers-menu-command-entries))
8b621d39 1846
bf902855
SM
1847 ;; We used to "(define-key (current-global-map) [menu-bar buffer]"
1848 ;; but that did not do the right thing when the [menu-bar buffer]
1849 ;; entry above had been moved (e.g. to a parent keymap).
1850 (setcdr global-buffers-menu-map (cons "Select Buffer" buffers-menu)))))
09642d97
RS
1851
1852(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
2f1139a4 1853
3f557298
RS
1854(menu-bar-update-buffers)
1855
40954111 1856;; this version is too slow
a9d96061
SM
1857;;(defun format-buffers-menu-line (buffer)
1858;; "Returns a string to represent the given buffer in the Buffer menu.
1859;;nil means the buffer shouldn't be listed. You can redefine this."
1860;; (if (string-match "\\` " (buffer-name buffer))
1861;; nil
7fdbcd83 1862;; (with-current-buffer buffer
a9d96061
SM
1863;; (let ((size (buffer-size)))
1864;; (format "%s%s %-19s %6s %-15s %s"
1865;; (if (buffer-modified-p) "*" " ")
1866;; (if buffer-read-only "%" " ")
1867;; (buffer-name)
1868;; size
1869;; mode-name
1870;; (or (buffer-file-name) ""))))))
40954111 1871\f
25b048ee
RS
1872;;; Set up a menu bar menu for the minibuffer.
1873
32993295
SM
1874(dolist (map (list minibuffer-local-map
1875 ;; This shouldn't be necessary, but there's a funny
1876 ;; bug in keymap.c that I don't understand yet. -stef
d918e2dc
SM
1877 minibuffer-local-completion-map))
1878 (define-key map [menu-bar minibuf]
8f43cbf3 1879 (cons (purecopy "Minibuf") (make-sparse-keymap "Minibuf"))))
d918e2dc 1880
32993295 1881(let ((map minibuffer-local-completion-map))
d918e2dc 1882 (define-key map [menu-bar minibuf ?\?]
98b9bf40
JL
1883 `(menu-item ,(purecopy "List Completions") minibuffer-completion-help
1884 :help ,(purecopy "Display all possible completions")))
d918e2dc 1885 (define-key map [menu-bar minibuf space]
98b9bf40
JL
1886 `(menu-item ,(purecopy "Complete Word") minibuffer-complete-word
1887 :help ,(purecopy "Complete at most one word")))
d918e2dc 1888 (define-key map [menu-bar minibuf tab]
98b9bf40
JL
1889 `(menu-item ,(purecopy "Complete") minibuffer-complete
1890 :help ,(purecopy "Complete as far as possible"))))
d918e2dc 1891
32993295 1892(let ((map minibuffer-local-map))
d918e2dc 1893 (define-key map [menu-bar minibuf quit]
98b9bf40
JL
1894 `(menu-item ,(purecopy "Quit") abort-recursive-edit
1895 :help ,(purecopy "Abort input and exit minibuffer")))
d918e2dc 1896 (define-key map [menu-bar minibuf return]
98b9bf40 1897 `(menu-item ,(purecopy "Enter") exit-minibuffer
1e8780b1 1898 :key-sequence ,(purecopy "\r")
98b9bf40 1899 :help ,(purecopy "Terminate input and exit minibuffer")))
56a8f9c5 1900 (define-key map [menu-bar minibuf isearch-forward]
98b9bf40
JL
1901 `(menu-item ,(purecopy "Isearch History Forward") isearch-forward
1902 :help ,(purecopy "Incrementally search minibuffer history forward")))
56a8f9c5 1903 (define-key map [menu-bar minibuf isearch-backward]
98b9bf40
JL
1904 `(menu-item ,(purecopy "Isearch History Backward") isearch-backward
1905 :help ,(purecopy "Incrementally search minibuffer history backward")))
56a8f9c5 1906 (define-key map [menu-bar minibuf next]
98b9bf40
JL
1907 `(menu-item ,(purecopy "Next History Item") next-history-element
1908 :help ,(purecopy "Put next minibuffer history element in the minibuffer")))
56a8f9c5 1909 (define-key map [menu-bar minibuf previous]
98b9bf40
JL
1910 `(menu-item ,(purecopy "Previous History Item") previous-history-element
1911 :help ,(purecopy "Put previous minibuffer history element in the minibuffer"))))
25b048ee 1912\f
8ab9589d 1913;;;###autoload
ffda926c 1914;; This comment is taken from tool-bar.el near
8ab9589d
JD
1915;; (put 'tool-bar-mode ...)
1916;; We want to pretend the menu bar by standard is on, as this will make
1917;; customize consider disabling the menu bar a customization, and save
1918;; that. We could do this for real by setting :init-value below, but
1919;; that would overwrite disabling the tool bar from X resources.
1920(put 'menu-bar-mode 'standard-value '(t))
1921
8ab9589d 1922(define-minor-mode menu-bar-mode
dfd29450 1923 "Toggle display of a menu bar on each frame.
057d49d1
RS
1924This command applies to all frames that exist and frames to be
1925created in the future.
e1d18ad8
RS
1926With a numeric argument, if the argument is positive,
1927turn on menu bars; otherwise, turn off menu bars."
8ab9589d
JD
1928 :init-value nil
1929 :global t
1930 :group 'frames
095fe281 1931
7b7d6615 1932 ;; Make menu-bar-mode and default-frame-alist consistent.
095fe281
KL
1933 (modify-all-frames-parameters (list (cons 'menu-bar-lines
1934 (if menu-bar-mode 1 0))))
8ab9589d
JD
1935
1936 ;; Make the message appear when Emacs is idle. We can not call message
1937 ;; directly. The minor-mode message "Menu-bar mode disabled" comes
1938 ;; after this function returns, overwriting any message we do here.
32226619 1939 (when (and (called-interactively-p 'interactive) (not menu-bar-mode))
8ab9589d
JD
1940 (run-with-idle-timer 0 nil 'message
1941 "Menu-bar mode disabled. Use M-x menu-bar-mode to make the menu bar appear."))
09bfa5ca 1942 menu-bar-mode)
1db87953 1943
6a5af08f
KL
1944(defun toggle-menu-bar-mode-from-frame (&optional arg)
1945 "Toggle menu bar on or off, based on the status of the current frame.
1946See `menu-bar-mode' for more information."
1947 (interactive (list (or current-prefix-arg 'toggle)))
1948 (if (eq arg 'toggle)
1949 (menu-bar-mode (if (> (frame-parameter nil 'menu-bar-lines) 0) 0 1))
1950 (menu-bar-mode arg)))
1951
f464330b 1952(declare-function x-menu-bar-open "term/x-win" (&optional frame))
1ad31f1b 1953(declare-function w32-menu-bar-open "term/w32-win" (&optional frame))
f464330b 1954
14ab3a40
KL
1955(defun menu-bar-open (&optional frame)
1956 "Start key navigation of the menu bar in FRAME.
1957
1958This function decides which method to use to access the menu
1959depending on FRAME's terminal device. On X displays, it calls
14f3467e
JR
1960`x-menu-bar-open'; on Windows, `w32-menu-bar-open' otherwise it
1961calls `tmm-menubar'.
14ab3a40
KL
1962
1963If FRAME is nil or not given, use the selected frame."
1964 (interactive)
14f3467e
JR
1965 (let ((type (framep (or frame (selected-frame)))))
1966 (cond
1967 ((eq type 'x) (x-menu-bar-open frame))
1968 ((eq type 'w32) (w32-menu-bar-open frame))
1969 (t (with-selected-frame (or frame (selected-frame))
1970 (tmm-menubar))))))
14ab3a40
KL
1971
1972(global-set-key [f10] 'menu-bar-open)
1973
bffa5d4d
RS
1974(provide 'menu-bar)
1975
bf902855 1976;; arch-tag: 6e6a3c22-4ec4-4d3d-8190-583f8ef94ced
235aa29b 1977;;; menu-bar.el ends here